From 49acc40ce77b21f8c325d6ffd17ed17dae2f8678 Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Sat, 19 Dec 2020 12:16:25 -0800 Subject: [PATCH 01/18] proof of concept --- src/Data/List/Lazy.purs | 19 +- src/Data/List/Lazy/NonEmpty.purs | 169 ++++++++ src/Data/List/NonEmpty.purs | 17 +- test/Test/Common.purs | 547 ++++++++++++++++++++++++++ test/Test/CommonDiffEmptiability.purs | 245 ++++++++++++ test/Test/Main.purs | 11 +- test/Test/OnlyCanEmpty.purs | 170 ++++++++ test/Test/OnlyLazy.purs | 62 +++ test/Test/OnlyNonEmpty.purs | 109 +++++ test/Test/OnlyStrict.purs | 76 ++++ test/Test/UpdatedTests.purs | 95 +++++ 11 files changed, 1515 insertions(+), 5 deletions(-) create mode 100644 test/Test/Common.purs create mode 100644 test/Test/CommonDiffEmptiability.purs create mode 100644 test/Test/OnlyCanEmpty.purs create mode 100644 test/Test/OnlyLazy.purs create mode 100644 test/Test/OnlyNonEmpty.purs create mode 100644 test/Test/OnlyStrict.purs create mode 100644 test/Test/UpdatedTests.purs diff --git a/src/Data/List/Lazy.purs b/src/Data/List/Lazy.purs index 8821753..9814d4b 100644 --- a/src/Data/List/Lazy.purs +++ b/src/Data/List/Lazy.purs @@ -61,12 +61,14 @@ module Data.List.Lazy , stripPrefix , slice , take + , takeEnd , takeWhile , drop , dropWhile , span , group -- , group' + , groupAll , groupBy , partition @@ -115,6 +117,7 @@ import Data.Traversable (scanl, scanr) as Exports import Data.Traversable (sequence) import Data.Tuple (Tuple(..)) import Data.Unfoldable (class Unfoldable, unfoldr) +import Partial.Unsafe (unsafeCrashWith) -- | Convert a list into any unfoldable structure. -- | @@ -506,6 +509,12 @@ take n = if n <= 0 go _ Nil = Nil go n' (Cons x xs) = Cons x (take (n' - 1) xs) +-- | Take the specified number of elements from the end of a list. +-- | +-- | Running time: Todo +takeEnd :: forall a. Int -> List a -> List a +takeEnd _ _ = unsafeCrashWith "todo takeEnd for Lazy List" + -- | Take those elements from the front of a list which match a predicate. -- | -- | Running time (worst case): `O(n)` @@ -521,7 +530,7 @@ takeWhile p = List <<< map go <<< unwrap drop :: forall a. Int -> List a -> List a drop n = List <<< map (go n) <<< unwrap where - go 0 xs = xs + go n' xs | n' < 1 = xs go _ Nil = Nil go n' (Cons _ xs) = go (n' - 1) (step xs) @@ -566,6 +575,14 @@ span p xs = group :: forall a. Eq a => List a -> List (NEL.NonEmptyList a) group = groupBy (==) +-- | Group equal elements of a list into lists. +-- | +-- | Todo - fix documentation mismatch of above `group` with non-lazy version. +-- | ``` +groupAll :: forall a. Ord a => List a -> List (NEL.NonEmptyList a) +groupAll = unsafeCrashWith "todo groupAll for Lazy List" +--groupAll = group <<< sort + -- | Group equal, consecutive elements of a list into lists, using the specified -- | equivalence relation to determine equality. -- | diff --git a/src/Data/List/Lazy/NonEmpty.purs b/src/Data/List/Lazy/NonEmpty.purs index 20ef04a..6c1c8f1 100644 --- a/src/Data/List/Lazy/NonEmpty.purs +++ b/src/Data/List/Lazy/NonEmpty.purs @@ -13,8 +13,49 @@ module Data.List.Lazy.NonEmpty , init , uncons , length + , concat , concatMap , appendFoldable + -- additions + , catMaybes + , cons + , drop + , dropWhile + , elemIndex + , elemLastIndex + , filter + , filterM + , findIndex + , findLastIndex + , foldM + , group + , groupAll + , groupBy + , index + , insertAt + , intersect + , intersectBy + , mapMaybe + , modifyAt + , nubEq + , nubByEq + , partition + , range + , reverse + , snoc + , span + , take + , takeEnd + , takeWhile + , union + , unionBy + , unzip + , updateAt + , zip + , zipWith + , zipWithA + + ) where import Prelude @@ -28,6 +69,128 @@ import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.NonEmpty ((:|)) import Data.Tuple (Tuple(..)) import Data.Unfoldable (class Unfoldable, unfoldr) +import Partial.Unsafe (unsafeCrashWith) + +--- Sorted additions ------ + +-- | Filter a list of optional values, keeping only the elements which contain +-- | a value. +catMaybes :: forall a. NonEmptyList (Maybe a) -> L.List a +catMaybes _ = unsafeCrashWith "todo catMaybes for Lazy NonEmptyList" +--catMaybes = mapMaybe identity + +cons :: forall a. a -> NonEmptyList a -> NonEmptyList a +cons _ _ = unsafeCrashWith "todo cons for Lazy NonEmptyList" + +-- | Drop the specified number of elements from the front of a list. +drop :: forall a. Int -> NonEmptyList a -> L.List a +drop _ _ = unsafeCrashWith "todo drop for Lazy NonEmptyList" + +dropWhile :: forall a. (a -> Boolean) -> NonEmptyList a -> L.List a +dropWhile _ _ = unsafeCrashWith "todo dropWhile for Lazy NonEmptyList" + +elemIndex :: forall a. Eq a => a -> NonEmptyList a -> Maybe Int +elemIndex _ _ = unsafeCrashWith "todo elemIndex for Lazy NonEmptyList" + +elemLastIndex :: forall a. Eq a => a -> NonEmptyList a -> Maybe Int +elemLastIndex _ _ = unsafeCrashWith "todo elemLastIndex for Lazy NonEmptyList" + +filter :: forall a. (a -> Boolean) -> NonEmptyList a -> L.List a +filter _ _ = unsafeCrashWith "todo filter for Lazy NonEmptyList" + +filterM :: forall m a. Monad m => (a -> m Boolean) -> NonEmptyList a -> m (L.List a) +filterM _ _ = unsafeCrashWith "todo filterM for Lazy NonEmptyList" + +findIndex :: forall a. (a -> Boolean) -> NonEmptyList a -> Maybe Int +findIndex _ _ = unsafeCrashWith "todo findIndex for Lazy NonEmptyList" + +findLastIndex :: forall a. (a -> Boolean) -> NonEmptyList a -> Maybe Int +findLastIndex _ _ = unsafeCrashWith "todo findLastIndex for Lazy NonEmptyList" + +foldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> NonEmptyList a -> m b +foldM _ _ _ = unsafeCrashWith "todo foldM for Lazy NonEmptyList" + +group :: forall a. Eq a => NonEmptyList a -> NonEmptyList (NonEmptyList a) +group _ = unsafeCrashWith "todo group for Lazy NonEmptyList" + +groupAll :: forall a. Ord a => NonEmptyList a -> NonEmptyList (NonEmptyList a) +groupAll _ = unsafeCrashWith "todo groupAll for Lazy NonEmptyList" + +groupBy :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList (NonEmptyList a) +groupBy _ _ = unsafeCrashWith "todo groupBy for Lazy NonEmptyList" + +index :: forall a. NonEmptyList a -> Int -> Maybe a +index _ _ = unsafeCrashWith "todo index for Lazy NonEmptyList" + +insertAt :: forall a. Int -> a -> NonEmptyList a -> NonEmptyList a +insertAt _ _ _ = unsafeCrashWith "todo insertAt for Lazy NonEmptyList" + +intersect :: forall a. Eq a => NonEmptyList a -> NonEmptyList a -> NonEmptyList a +intersect _ _ = unsafeCrashWith "todo intersect for Lazy NonEmptyList" + +intersectBy :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList a -> NonEmptyList a +intersectBy _ _ _ = unsafeCrashWith "todo intersectBy for Lazy NonEmptyList" + +mapMaybe :: forall a b. (a -> Maybe b) -> NonEmptyList a -> L.List b +mapMaybe _ _ = unsafeCrashWith "todo mapMaybe for Lazy NonEmptyList" + +modifyAt :: forall a. Int -> (a -> a) -> NonEmptyList a -> NonEmptyList a +modifyAt _ _ _ = unsafeCrashWith "todo modifyAt for Lazy NonEmptyList" + +nubEq :: forall a. Eq a => NonEmptyList a -> NonEmptyList a +nubEq _ = unsafeCrashWith "todo nubEq for Lazy NonEmptyList" + +nubByEq :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList a +nubByEq _ _ = unsafeCrashWith "todo nubByEq for Lazy NonEmptyList" + +partition :: forall a. (a -> Boolean) -> NonEmptyList a -> { yes :: L.List a, no :: L.List a } +partition _ _ = unsafeCrashWith "todo partition for Lazy NonEmptyList" +range :: Int -> Int -> NonEmptyList Int +range _ _ = unsafeCrashWith "todo range for Lazy NonEmptyList" + +reverse :: forall a. NonEmptyList a -> NonEmptyList a +reverse _ = unsafeCrashWith "todo reverse for Lazy NonEmptyList" + +snoc :: forall a. NonEmptyList a -> a -> NonEmptyList a +snoc _ _ = unsafeCrashWith "todo snoc for Lazy NonEmptyList" + +snoc' :: forall a. L.List a -> a -> NonEmptyList a +snoc' _ _ = unsafeCrashWith "todo snoc' for Lazy NonEmptyList" + +span :: forall a. (a -> Boolean) -> NonEmptyList a -> { init :: L.List a, rest :: L.List a } +span _ _ = unsafeCrashWith "todo span for Lazy NonEmptyList" + +take :: forall a. Int -> NonEmptyList a -> L.List a +take _ _ = unsafeCrashWith "todo take for Lazy NonEmptyList" + +takeEnd :: forall a. Int -> NonEmptyList a -> L.List a +takeEnd _ _ = unsafeCrashWith "todo takeEnd for Lazy NonEmptyList" + +takeWhile :: forall a. (a -> Boolean) -> NonEmptyList a -> L.List a +takeWhile _ _ = unsafeCrashWith "todo takeWhile for Lazy NonEmptyList" + +union :: forall a. Eq a => NonEmptyList a -> NonEmptyList a -> NonEmptyList a +union _ _ = unsafeCrashWith "todo union for Lazy NonEmptyList" + +unionBy :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList a -> NonEmptyList a +unionBy _ _ _ = unsafeCrashWith "todo unionBy for Lazy NonEmptyList" + +unzip :: forall a b. NonEmptyList (Tuple a b) -> Tuple (NonEmptyList a) (NonEmptyList b) +unzip _ = unsafeCrashWith "todo unzip for Lazy NonEmptyList" + +updateAt :: forall a. Int -> a -> NonEmptyList a -> NonEmptyList a +updateAt _ _ _ = unsafeCrashWith "todo updateAt for Lazy NonEmptyList" + +zip :: forall a b. NonEmptyList a -> NonEmptyList b -> NonEmptyList (Tuple a b) +zip _ _ = unsafeCrashWith "todo zip for Lazy NonEmptyList" + +zipWith :: forall a b c. (a -> b -> c) -> NonEmptyList a -> NonEmptyList b -> NonEmptyList c +zipWith _ _ _ = unsafeCrashWith "todo zipWith for Lazy NonEmptyList" + +zipWithA :: forall m a b c. Applicative m => (a -> b -> m c) -> NonEmptyList a -> NonEmptyList b -> m (NonEmptyList c) +zipWithA _ _ _ = unsafeCrashWith "todo zipWithA for Lazy NonEmptyList" + +----------- toUnfoldable :: forall f. Unfoldable f => NonEmptyList ~> f toUnfoldable = @@ -75,6 +238,12 @@ uncons (NonEmptyList nel) = case force nel of x :| xs -> { head: x, tail: xs } length :: forall a. NonEmptyList a -> Int length (NonEmptyList nel) = case force nel of _ :| xs -> 1 + L.length xs +-- | Flatten a list of lists. +-- | +-- | Running time: `O(n)`, where `n` is the total number of elements. +concat :: forall a. NonEmptyList (NonEmptyList a) -> NonEmptyList a +concat = (_ >>= identity) + concatMap :: forall a b. (a -> NonEmptyList b) -> NonEmptyList a -> NonEmptyList b concatMap = flip bind diff --git a/src/Data/List/NonEmpty.purs b/src/Data/List/NonEmpty.purs index 01c3db7..4ff65ce 100644 --- a/src/Data/List/NonEmpty.purs +++ b/src/Data/List/NonEmpty.purs @@ -5,6 +5,7 @@ module Data.List.NonEmpty , fromList , toList , singleton + , (..), range , length , cons , cons' @@ -36,6 +37,7 @@ module Data.List.NonEmpty , sort , sortBy , take + , takeEnd , takeWhile , drop , dropWhile @@ -69,13 +71,13 @@ import Data.FunctorWithIndex (mapWithIndex) as FWI import Data.List ((:)) import Data.List as L import Data.List.Types (NonEmptyList(..)) -import Data.Maybe (Maybe(..), fromMaybe, maybe) +import Data.Maybe (Maybe(..), fromJust, fromMaybe, maybe) import Data.NonEmpty ((:|)) import Data.NonEmpty as NE import Data.Semigroup.Traversable (sequence1) import Data.Tuple (Tuple(..), fst, snd) import Data.Unfoldable (class Unfoldable, unfoldr) -import Partial.Unsafe (unsafeCrashWith) +import Partial.Unsafe (unsafeCrashWith, unsafePartial) import Data.Foldable (foldl, foldr, foldMap, fold, intercalate, elem, notElem, find, findMap, any, all) as Exports import Data.Semigroup.Foldable (fold1, foldMap1, for1_, sequence1_, traverse1_) as Exports @@ -133,6 +135,14 @@ toList (NonEmptyList (x :| xs)) = x : xs singleton :: forall a. a -> NonEmptyList a singleton = NonEmptyList <<< NE.singleton +-- | An infix synonym for `range`. +infix 8 range as .. + +-- | Create a list containing a range of integers, including both endpoints. +-- Todo, rewrite this without unsafe workaround (if necessary) +range :: Int -> Int -> NonEmptyList Int +range start end = unsafePartial fromJust $ fromList $ L.range start end + cons :: forall a. a -> NonEmptyList a -> NonEmptyList a cons y (NonEmptyList (x :| xs)) = NonEmptyList (y :| x : xs) @@ -250,6 +260,9 @@ sortBy = wrappedOperation "sortBy" <<< L.sortBy take :: forall a. Int -> NonEmptyList a -> L.List a take = lift <<< L.take +takeEnd :: forall a. Int -> NonEmptyList a -> L.List a +takeEnd = lift <<< L.takeEnd + takeWhile :: forall a. (a -> Boolean) -> NonEmptyList a -> L.List a takeWhile = lift <<< L.takeWhile diff --git a/test/Test/Common.purs b/test/Test/Common.purs new file mode 100644 index 0000000..ad75a9b --- /dev/null +++ b/test/Test/Common.purs @@ -0,0 +1,547 @@ +module Test.Common where + +import Prelude + +import Control.Alt (class Alt, (<|>)) +import Control.Extend (class Extend, (<<=)) +import Data.Array as Array +import Data.Eq (class Eq1) +import Data.Foldable (class Foldable, foldMap, foldl, sum) +import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex) +import Data.Function (on) +import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) +import Data.Int (odd) +import Data.Maybe (Maybe(..), fromJust) +import Data.Monoid.Additive (Additive(..)) +import Data.Ord (class Ord1) +import Data.Traversable (class Traversable, traverse) +import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) +import Data.Tuple (Tuple(..)) +import Data.Unfoldable (class Unfoldable, replicate, replicateA, unfoldr) +import Data.Unfoldable1 (class Unfoldable1, unfoldr1) +import Effect (Effect) +import Effect.Console (log) +import Partial.Unsafe (unsafePartial) +import Test.Assert (assert) + +import Data.List as L +import Data.List.NonEmpty as NEL +import Data.List.Lazy as LL +import Data.List.Lazy.NonEmpty as LNEL + +{- +This is temporarily being used during development. +It allows testing while still patching the API. +This is passed as an additional argument to testCommon +to indicate which container type is being tested, and +lets us skip gaps that are currently implemented by `unsafeCrashWith`: + +Once fully supported by all containers, can replace with original assert. +-} +data SkipBroken + = SkipBrokenStrictCanEmpty + | SkipBrokenStrictNonEmpty + | SkipBrokenLazyCanEmpty + | SkipBrokenLazyNonEmpty + | RunAll + +derive instance eqSkipBroken :: Eq SkipBroken + +assertSkipHelper :: SkipBroken -> Array SkipBroken -> (_ -> Boolean) -> Effect Unit +assertSkipHelper skip arr f = + case Array.elem skip arr of + true -> log "...skipped" + false -> assert $ f unit + +printContainerType :: String -> Effect Unit +printContainerType str = do + log "--------------------------------" + log str + log "--------------------------------" + +printTestType :: String -> Effect Unit +printTestType str = do + log $ "---- " <> str <> " Tests ----" + +class ( + Alt c + , Applicative c + , Apply c + , Bind c + , Eq (c Int) + --, Eq1 c -- missing from NonEmptyList, LazyNonEmptyList + , Extend c + , Foldable c + , FoldableWithIndex Int c + , Functor c + , FunctorWithIndex Int c + , Monad c + , Ord (c Int) + --, Ord1 c -- missing from NonEmptyList, LazyNonEmptyList + , Semigroup (c Int) + , Show (c Int) + , Traversable c + , TraversableWithIndex Int c + , Unfoldable1 c +) <= Common c where + concat :: forall a. c (c a) -> c a + concatMap :: forall a. forall b. (a -> c b) -> c a -> c b + -- Should basic list have a cons function wrapping the Cons constructor? + cons :: forall a. a -> c a -> c a + elemIndex :: forall a. Eq a => a -> c a -> Maybe Int + elemLastIndex :: forall a. Eq a => a -> c a -> Maybe Int + findIndex :: forall a. (a -> Boolean) -> c a -> Maybe Int + findLastIndex :: forall a. (a -> Boolean) -> c a -> Maybe Int + foldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> c a -> m b + index :: forall a. c a -> Int -> Maybe a + intersect :: forall a. Eq a => c a -> c a -> c a + intersectBy :: forall a. (a -> a -> Boolean) -> c a -> c a -> c a + length :: forall a. c a -> Int + nubEq :: forall a. Eq a => c a -> c a + nubByEq :: forall a. (a -> a -> Boolean) -> c a -> c a + reverse :: c ~> c + singleton :: forall a. a -> c a + snoc :: forall a. c a -> a -> c a + toUnfoldable :: forall f a. Unfoldable f => c a -> f a + union :: forall a. Eq a => c a -> c a -> c a + unionBy :: forall a. (a -> a -> Boolean) -> c a -> c a -> c a + -- Types don't have to be all a + -- Todo - double check this requirement + unzip :: forall a b. c (Tuple a b) -> Tuple (c a) (c b) + zip :: forall a b. c a -> c b -> c (Tuple a b) + zipWith :: forall a b d. (a -> b -> d) -> c a -> c b -> c d + zipWithA :: forall a b d m. Applicative m => (a -> b -> m d) -> c a -> c b -> m (c d) + + -- Todo - add to + -- NonEmpty + range :: Int -> Int -> c Int + + makeContainer :: forall f a. Foldable f => f a -> c a + +-- Don't know how to define this in Test.Data.List +-- Wrapping is tricky. +instance commonList :: Common L.List where + makeContainer = L.fromFoldable + + concat = L.concat + concatMap = L.concatMap + cons = L.Cons + elemIndex = L.elemIndex + elemLastIndex = L.elemLastIndex + findIndex = L.findIndex + findLastIndex = L.findLastIndex + foldM = L.foldM + index = L.index + intersect = L.intersect + intersectBy = L.intersectBy + length = L.length + nubEq = L.nubEq + nubByEq = L.nubByEq + range = L.range + reverse = L.reverse + singleton = L.singleton + snoc = L.snoc + toUnfoldable = L.toUnfoldable + union = L.union + unionBy = L.unionBy + unzip = L.unzip + zip = L.zip + zipWith = L.zipWith + zipWithA = L.zipWithA + +instance commonNonEmptyList :: Common NEL.NonEmptyList where + makeContainer = unsafePartial fromJust <<< NEL.fromFoldable + + concat = NEL.concat + concatMap = NEL.concatMap + cons = NEL.cons + elemIndex = NEL.elemIndex + elemLastIndex = NEL.elemLastIndex + findIndex = NEL.findIndex + findLastIndex = NEL.findLastIndex + foldM = NEL.foldM + index = NEL.index + intersect = NEL.intersect + intersectBy = NEL.intersectBy + length = NEL.length + nubEq = NEL.nubEq + nubByEq = NEL.nubByEq + range = NEL.range + reverse = NEL.reverse + singleton = NEL.singleton + snoc = NEL.snoc + toUnfoldable = NEL.toUnfoldable + union = NEL.union + unionBy = NEL.unionBy + unzip = NEL.unzip + zip = NEL.zip + zipWith = NEL.zipWith + zipWithA = NEL.zipWithA + +instance commonLazyList :: Common LL.List where + makeContainer = LL.fromFoldable + + concat = LL.concat + concatMap = LL.concatMap + cons = LL.cons + elemIndex = LL.elemIndex + elemLastIndex = LL.elemLastIndex + findIndex = LL.findIndex + findLastIndex = LL.findLastIndex + foldM = LL.foldM + index = LL.index + intersect = LL.intersect + intersectBy = LL.intersectBy + length = LL.length + nubEq = LL.nubEq + nubByEq = LL.nubByEq + range = LL.range + reverse = LL.reverse + singleton = LL.singleton + snoc = LL.snoc + toUnfoldable = LL.toUnfoldable + union = LL.union + unionBy = LL.unionBy + unzip = LL.unzip + zip = LL.zip + zipWith = LL.zipWith + zipWithA = LL.zipWithA + +instance commonLazyNonEmptyList :: Common LNEL.NonEmptyList where + makeContainer = unsafePartial fromJust <<< LNEL.fromFoldable + + concat = LNEL.concat + concatMap = LNEL.concatMap + cons = LNEL.cons + elemIndex = LNEL.elemIndex + elemLastIndex = LNEL.elemLastIndex + findIndex = LNEL.findIndex + findLastIndex = LNEL.findLastIndex + foldM = LNEL.foldM + index = LNEL.index + intersect = LNEL.intersect + intersectBy = LNEL.intersectBy + length = LNEL.length + nubEq = LNEL.nubEq + nubByEq = LNEL.nubByEq + range = LNEL.range + reverse = LNEL.reverse + singleton = LNEL.singleton + snoc = LNEL.snoc + toUnfoldable = LNEL.toUnfoldable + union = LNEL.union + unionBy = LNEL.unionBy + unzip = LNEL.unzip + zip = LNEL.zip + zipWith = LNEL.zipWith + zipWithA = LNEL.zipWithA + +testCommon :: forall c. + Common c => + Eq (c String) => + Eq (c (Tuple Int String)) => + Eq (c (c String)) => + c Int -> Effect Unit +-- Would likely be better to pass a proxy type +testCommon _ = do + let + l :: forall f a. Foldable f => f a -> c a + l = makeContainer + + rg :: Int -> Int -> c Int + rg = range + + k100 :: c _ + k100 = range 1 100000 + + printTestType "Common" + + -- Duplicating this test out of alphabetical order, since many other tests rely on it. + log "range should create an inclusive container of integers for the specified start and end" + assert $ (range 3 3) == l [3] + --assertSkip \_ -> (range 3 3) == l [3] + assert $ (range 0 5) == l [0, 1, 2, 3, 4, 5] + assert $ (range 2 (-3)) == l [2, 1, 0, -1, -2, -3] + + -- ======= Typeclass tests ======== + + -- Alt + -- alt :: forall a. f a -> f a -> f a + -- Don't know in what situations this is different than append + log "Alt's alt (<|>) should append containers" + assert $ (l [1,2] <|> l [3,4]) == l [1,2,3,4] + + -- Applicative + -- pure :: forall a. a -> f a + log "Applicative's pure should construct a container with a single value" + assert $ pure 5 == l [5] + + -- Apply + -- apply :: forall a b. f (a -> b) -> f a -> f b + -- Todo - pass in a helper container of functions + -- or function that creates a container of functions + + -- Bind c + -- bind :: forall a b. m a -> (a -> m b) -> m b + log "Bind's bind (>>=) should append the results of a container-generating function\ + \applied to each element in the container" + assert $ (l [1,2,3] >>= \x -> l [x,10+x]) == l [1,11,2,12,3,13] + + -- Eq + -- eq :: a -> a -> Boolean + log "Eq's eq (==) should correctly test containers for equality" + assert $ l [1,2] == l [1,2] + assert $ not $ l [1,2] == l [2,2] + + -- Eq1 -- missing from NonEmptyList, LazyNonEmptyList + -- eq1 :: forall a. Eq a => f a -> f a -> Boolean + -- Todo + + -- Extend + -- extend :: forall b a. (w a -> b) -> w a -> w b + log "Extend's extend (<<=) should create a container containing the results\ + \of a function that is applied to increasingly smaller chunks of an input\ + \container. Each iteration drops an element from the front of the input container." + assert $ (sum <<= l [1,2,3,4]) == l [10,9,7,4] + + -- Foldable + -- foldr :: forall a b. (a -> b -> b) -> b -> f a -> b + -- foldl :: forall a b. (b -> a -> b) -> b -> f a -> b + -- foldMap :: forall a m. Monoid m => (a -> m) -> f a -> m + -- These are just the pre-existing tests. They could be more comprehensive. + + log "foldl should be stack-safe" + void $ pure $ foldl (+) 0 k100 + + log "foldMap should be stack-safe" + void $ pure $ foldMap Additive k100 + + log "foldMap should be left-to-right" + assert $ foldMap show (rg 1 5) == "12345" + + -- FoldableWithIndex + -- foldrWithIndex :: forall a b. (i -> a -> b -> b) -> b -> f a -> b + -- foldlWithIndex :: forall a b. (i -> b -> a -> b) -> b -> f a -> b + -- foldMapWithIndex :: forall a m. Monoid m => (i -> a -> m) -> f a -> m + -- Todo - Existing tests, opportunities for improvement + + log "foldlWithIndex should be correct" + assert $ foldlWithIndex (\i b _ -> i + b) 0 (rg 0 10000) == 50005000 + + log "foldlWithIndex should be stack-safe" + void $ pure $ foldlWithIndex (\i b _ -> i + b) 0 k100 + + log "foldrWithIndex should be correct" + assert $ foldrWithIndex (\i _ b -> i + b) 0 (rg 0 10000) == 50005000 + + log "foldrWithIndex should be stack-safe" + void $ pure $ foldrWithIndex (\i _ b -> i + b) 0 k100 + + log "foldMapWithIndex should be stack-safe" + void $ pure $ foldMapWithIndex (\i _ -> Additive i) k100 + + log "foldMapWithIndex should be left-to-right" + assert $ foldMapWithIndex (\i _ -> show i) (l [0, 0, 0]) == "012" + + -- Functor + -- map :: forall a b. (a -> b) -> f a -> f b + + log "map should maintain order" + assert $ rg 1 5 == (map identity $ rg 1 5) + + log "map should be stack-safe" + void $ pure $ map identity k100 + -- Todo - The below test also performs the same stack-safety check + + log "map should be correct" + assert $ rg 1 100000 == (map (_ + 1) $ rg 0 99999) + + + -- FunctorWithIndex + -- mapWithIndex :: forall a b. (i -> a -> b) -> f a -> f b + -- Todo - improve pre-existing + + log "mapWithIndex should take a container of values and apply a function which also takes the index into account" + assert $ mapWithIndex add (l [0, 1, 2, 3]) == l [0, 2, 4, 6] + + -- Monad + -- indicates Applicative and Bind + -- No specific tests + + -- Ord + -- compare :: a -> a -> Ordering + -- Todo - add tests + + -- Ord1 -- missing from NonEmptyList, LazyNonEmptyList + -- compare1 :: forall a. Ord a => f a -> f a -> Ordering + -- Todo - add tests + + -- Semigroup + -- append :: a -> a -> a + + log "append should concatenate two containers" + assert $ (l [1, 2]) <> (l [3, 4]) == (l [1, 2, 3, 4]) + + log "append should be stack-safe" + void $ pure $ k100 <> k100 + + -- Show + -- show :: a -> String + -- This is not testable in a generic way + + -- Traversable + -- traverse :: forall a b m. Applicative m => (a -> m b) -> t a -> m (t b) + -- sequence :: forall a m. Applicative m => t (m a) -> m (t a) + -- Todo - improve pre-existing tests + -- Todo - add sequence test + + log "traverse should be stack-safe" + assert $ traverse Just k100 == Just k100 + + -- TraversableWithIndex + -- traverseWithIndex :: forall a b m. Applicative m => (i -> a -> m b) -> t a -> m (t b) + + log "traverseWithIndex should be stack-safe" + assert $ traverseWithIndex (const Just) k100 == Just k100 + + log "traverseWithIndex should be correct" + assert $ traverseWithIndex (\i a -> Just $ i + a) (l [2, 2, 2]) + == Just (l [2, 3, 4]) + + -- Unfoldable1 + -- unfoldr1 :: forall a b. (b -> Tuple a (Maybe b)) -> b -> t a + + let + step1 :: Int -> Tuple Int (Maybe Int) + step1 n = Tuple n (if n >= 5 then Nothing else Just (n + 1)) + + log "unfoldr1 should maintain order" + assert $ rg 1 5 == unfoldr1 step1 1 + + -- =========== Functions =========== + + -- Todo - split + -- log "catMaybe should take a container of Maybe values and throw out Nothings" + -- assert $ catMaybes (l [Nothing, Just 2, Nothing, Just 4]) == l [2, 4] + + log "concat should join a container of containers" + assert $ (concat (l [l [1, 2], l [3, 4]])) == l [1, 2, 3, 4] + + let + doubleAndOrig :: Int -> c Int + doubleAndOrig x = cons (x * 2) $ singleton x + + log "concatMap should be equivalent to (concat <<< map)" + assert $ concatMap doubleAndOrig (l [1, 2, 3]) == concat (map doubleAndOrig (l [1, 2, 3])) + + log "cons should add an element to the front of the container" + assert $ cons 1 (l [2, 3]) == l [1,2,3] + + log "elemIndex should return the index of an item that a predicate returns true for in a container" + assert $ elemIndex 1 (l [1, 2, 1]) == Just 0 + assert $ elemIndex 4 (l [1, 2, 1]) == Nothing + + log "elemLastIndex should return the last index of an item in a container" + assert $ elemLastIndex 1 (l [1, 2, 1]) == Just 2 + assert $ elemLastIndex 4 (l [1, 2, 1]) == Nothing + + -- Todo split + -- log "filter should remove items that don't match a predicate" + -- assert $ filter odd (range 0 10) == l [1, 3, 5, 7, 9] + + --log "filterM should remove items that don't match a predicate while using a monadic behaviour" + --assert $ filterM (Just <<< odd) (range 0 10) == Just (l [1, 3, 5, 7, 9]) + --assert $ filterM (const Nothing) (rg 0 10) == Nothing + + log "findIndex should return the index of an item that a predicate returns true for in a container" + assert $ findIndex (_ /= 1) (l [1, 2, 1]) == Just 1 + assert $ findIndex (_ == 3) (l [1, 2, 1]) == Nothing + + log "findLastIndex should return the last index of an item in a container" + assert $ findLastIndex (_ /= 1) (l [2, 1, 2]) == Just 2 + assert $ findLastIndex (_ == 3) (l [2, 1, 2]) == Nothing + + log "foldM should perform a fold using a monadic step function" + assert $ foldM (\x y -> Just (x + y)) 0 (rg 1 10) == Just 55 + assert $ foldM (\_ _ -> Nothing) 0 (rg 1 10) == Nothing + + log "index (!!) should return Just x when the index is within the bounds of the container" + assert $ l [1, 2, 3] `index` 0 == (Just 1) + assert $ l [1, 2, 3] `index` 1 == (Just 2) + assert $ l [1, 2, 3] `index` 2 == (Just 3) + + log "index (!!) should return Nothing when the index is outside of the bounds of the container" + assert $ l [1, 2, 3] `index` 6 == Nothing + assert $ l [1, 2, 3] `index` (-1) == Nothing + + -- todo split + -- log "insertAt should add an item at the specified index" + -- assert $ (insertAt 0 1 (l [2, 3])) == Just (l [1, 2, 3]) + -- assert $ (insertAt 1 1 (l [2, 3])) == Just (l [2, 1, 3]) + -- assert $ (insertAt 2 1 (l [2, 3])) == Just (l [2, 3, 1]) + + -- log "insertAt should return Nothing if the index is out of range" + -- assert $ (insertAt 7 8 $ l [1,2,3]) == Nothing + + log "intersect should return the intersection of two containers" + assert $ intersect (l [1, 2, 3, 4, 3, 2, 1]) (l [1, 1, 2, 3]) == l [1, 2, 3, 3, 2, 1] + + log "intersectBy should return the intersection of two containers using the specified equivalence relation" + assert $ intersectBy (\x y -> (x * 2) == y) (l [1, 2, 3]) (l [2, 6]) == l [1, 3] + + log "length should return the number of items in a container" + assert $ length (l [1]) == 1 + assert $ length (l [1, 2, 3, 4, 5]) == 5 + + log "length should be stack-safe" + void $ pure $ length k100 + + -- todo split + -- log "modifyAt should update an item at the specified index" + -- assert $ (modifyAt 0 (_ + 1) (l [1, 2, 3])) == Just (l [2, 2, 3]) + -- assert $ (modifyAt 1 (_ + 1) (l [1, 2, 3])) == Just (l [1, 3, 3]) + + -- log "modifyAt should return Nothing if the index is out of range" + -- assert $ (modifyAt 7 (_ + 1) $ l [1,2,3]) == Nothing + + log "nubEq should remove duplicate elements from the container, keeping the first occurence" + assert $ nubEq (l [1, 2, 2, 3, 4, 1]) == l [1, 2, 3, 4] + + log "nubByEq should remove duplicate items from the container using a supplied predicate" + let mod3eq = eq `on` \n -> mod n 3 + assert $ nubByEq mod3eq (l [1, 3, 4, 5, 6]) == l [1, 3, 5] + + log "range should create an inclusive container of integers for the specified start and end" + assert $ (range 3 3) == l [3] + assert $ (range 0 5) == l [0, 1, 2, 3, 4, 5] + assert $ (range 2 (-3)) == l [2, 1, 0, -1, -2, -3] + + log "reverse should reverse the order of items in a container" + assert $ (reverse (l [1, 2, 3])) == l [3, 2, 1] + + log "singleton should construct a container with a single value" + assert $ singleton 5 == l [5] + + log "snoc should add an item to the end of a container" + assert $ l [1, 2, 3] `snoc` 4 == l [1, 2, 3, 4] + + -- Todo toUnfoldable + + log "union should produce the union of two containers" + assert $ union (l [1, 2, 3]) (l [2, 3, 4]) == l [1, 2, 3, 4] + assert $ union (l [1, 1, 2, 3]) (l [2, 3, 4]) == l [1, 1, 2, 3, 4] + + log "unionBy should produce the union of two containers using the specified equality relation" + assert $ unionBy (\_ y -> y < 5) (l [1, 2, 3]) (l [2, 3, 4, 5, 6]) == l [1, 2, 3, 5, 6] + + log "unzip should deconstruct a container of tuples into a tuple of containers" + assert $ unzip (l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"]) == Tuple (l [1, 2, 3]) (l ["a", "b", "c"]) + + log "zip should use the specified function to zip two containers together" + assert $ zip (l [1, 2, 3]) (l ["a", "b", "c"]) == l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"] + + log "zipWith should use the specified function to zip two containers together" + assert $ zipWith (\x y -> l [show x, y]) (l [1, 2, 3]) (l ["a", "b", "c"]) == l [l ["1", "a"], l ["2", "b"], l ["3", "c"]] + + log "zipWithA should use the specified function to zip two containers together" + assert $ zipWithA (\x y -> Just $ Tuple x y) (l [1, 2, 3]) (l ["a", "b", "c"]) == Just (l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"]) diff --git a/test/Test/CommonDiffEmptiability.purs b/test/Test/CommonDiffEmptiability.purs new file mode 100644 index 0000000..c34b56b --- /dev/null +++ b/test/Test/CommonDiffEmptiability.purs @@ -0,0 +1,245 @@ +module Test.CommonDiffEmptiability where + +import Prelude + +import Data.Foldable (class Foldable) +import Data.Function (on) +import Data.Maybe (Maybe(..), fromJust) +import Effect (Effect) +import Effect.Console (log) +import Partial.Unsafe (unsafePartial) +import Test.Assert (assert) + +import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeContainer, range) + +import Data.List as L +import Data.List.NonEmpty as NEL +import Data.List.Lazy as LL +import Data.List.Lazy.NonEmpty as LNEL + +{- +This is for testing common functions that have slightly different +signatures depending on whether the container may be empty or not. +For example: + CanEmpty (as `c`): + drop :: forall a. Int -> c a -> c a + fromFoldable :: forall f. Foldable f => f ~> c + group :: forall a. Eq a => c a -> c (nonEmpty a) + head :: forall a. c a -> Maybe a + NonEmpty (as `c`): + drop :: forall a. Int -> c a -> canEmpty a + fromFoldable :: forall f a. Foldable f => f a -> Maybe (c a) + group :: forall a. Eq a => c a -> c (c a) + head :: forall a. c a -> a + +These are consolidated by providing different type constructors to the typeclass instances. + +This generally works, but cannot be done if `Maybe` is present in one of the versions. +So functions like `fromFoldable` and `head` must be tested elswhere with some duplication. +The original plan was to pass another function with the same kind signature as `Maybe`, +such as: + type Id x = x +But creating an "identity" type alias doesn't work because: + - First-class type families are required: + - https://stackoverflow.com/questions/63865620/can-haskell-type-synonyms-be-used-as-type-constructors + - Typeclasses only match on type constructors and not any arbritrary + type-level function with the same kind signature. + - https://old.reddit.com/r/haskell/comments/26dshj/why_doesnt_haskell_allow_type_aliases_in_the/ +-} + + +class ( + Eq (c Int) +) <= CommonDiffEmptiability c canEmpty nonEmpty | c -> canEmpty nonEmpty where + + toCanEmpty :: forall a. c a -> canEmpty a + toNonEmpty :: forall a. c a -> nonEmpty a + + catMaybes :: forall a. c (Maybe a) -> canEmpty a + drop :: forall a. Int -> c a -> canEmpty a + dropWhile :: forall a. (a -> Boolean) -> c a -> canEmpty a + filter :: forall a. (a -> Boolean) -> c a -> canEmpty a + filterM :: forall m a. Monad m => (a -> m Boolean) -> c a -> m (canEmpty a) + group :: forall a. Eq a => c a -> c (nonEmpty a) + groupAll :: forall a. Ord a => c a -> c (nonEmpty a) + groupBy :: forall a. (a -> a -> Boolean) -> c a -> c (nonEmpty a) + mapMaybe :: forall a b. (a -> Maybe b) -> c a -> canEmpty b + partition :: forall a. (a -> Boolean) -> c a -> { no :: canEmpty a, yes :: canEmpty a } + span :: forall a. (a -> Boolean) -> c a -> { init :: canEmpty a, rest :: canEmpty a } + take :: forall a. Int -> c a -> canEmpty a + takeEnd :: forall a. Int -> c a -> canEmpty a + takeWhile :: forall a. (a -> Boolean) -> c a -> canEmpty a + + +instance commonDiffEmptiabilityCanEmptyList :: CommonDiffEmptiability L.List L.List NEL.NonEmptyList where + + toCanEmpty = identity + toNonEmpty = unsafePartial fromJust <<< NEL.fromList + + catMaybes = L.catMaybes + drop = L.drop + dropWhile = L.dropWhile + filter = L.filter + filterM = L.filterM + group = L.group + groupAll = L.groupAll + groupBy = L.groupBy + mapMaybe = L.mapMaybe + partition = L.partition + span = L.span + take = L.take + takeEnd = L.takeEnd + takeWhile = L.takeWhile + +instance commonDiffEmptiabilityNonEmptyList :: CommonDiffEmptiability NEL.NonEmptyList L.List NEL.NonEmptyList where + + toCanEmpty = NEL.toList + toNonEmpty = identity + + catMaybes = NEL.catMaybes + drop = NEL.drop + dropWhile = NEL.dropWhile + filter = NEL.filter + filterM = NEL.filterM + group = NEL.group + groupAll = NEL.groupAll + groupBy = NEL.groupBy + mapMaybe = NEL.mapMaybe + partition = NEL.partition + span = NEL.span + take = NEL.take + takeEnd = NEL.takeEnd + takeWhile = NEL.takeWhile + +instance commonDiffEmptiabilityCanEmptyLazyList :: CommonDiffEmptiability LL.List LL.List LNEL.NonEmptyList where + + toCanEmpty = identity + toNonEmpty = unsafePartial fromJust <<< LNEL.fromList + + catMaybes = LL.catMaybes + drop = LL.drop + dropWhile = LL.dropWhile + filter = LL.filter + filterM = LL.filterM + group = LL.group + groupAll = LL.groupAll + groupBy = LL.groupBy + mapMaybe = LL.mapMaybe + partition = LL.partition + span = LL.span + take = LL.take + takeEnd = LL.takeEnd + takeWhile = LL.takeWhile + +instance commonDiffEmptiabilityLazyNonEmptyList :: CommonDiffEmptiability LNEL.NonEmptyList LL.List LNEL.NonEmptyList where + + toCanEmpty = LNEL.toList + toNonEmpty = identity + + catMaybes = LNEL.catMaybes + drop = LNEL.drop + dropWhile = LNEL.dropWhile + filter = LNEL.filter + filterM = LNEL.filterM + group = LNEL.group + groupAll = LNEL.groupAll + groupBy = LNEL.groupBy + mapMaybe = LNEL.mapMaybe + partition = LNEL.partition + span = LNEL.span + take = LNEL.take + takeEnd = LNEL.takeEnd + takeWhile = LNEL.takeWhile + +testCommonDiffEmptiability :: forall c canEmpty nonEmpty. + Common c => + CommonDiffEmptiability c canEmpty nonEmpty => + Eq (c (nonEmpty Int)) => + Eq (canEmpty Int) => + SkipBroken -> c Int -> canEmpty Int -> nonEmpty Int -> Effect Unit +testCommonDiffEmptiability skip _ nil _ = do + let + l :: forall f a. Foldable f => f a -> c a + l = makeContainer + + cel :: forall f a. Foldable f => f a -> canEmpty a + cel = toCanEmpty <<< l + + nel :: forall f a. Foldable f => f a -> nonEmpty a + nel = toNonEmpty <<< l + + assertSkip :: Array SkipBroken -> (_ -> Boolean) -> Effect Unit + assertSkip = assertSkipHelper skip + + printTestType "Common (where signatures differ based on emptiability)" + + --catMaybes :: forall a. c (Maybe a) -> c a + -- todo + + log "drop should remove the specified number of items from the front of an list" + assert $ (drop 1 (l [1, 2, 3])) == cel [2, 3] + assert $ (drop (-1) (l [1, 2, 3])) == cel [1, 2, 3] + + log "dropWhile should remove all values that match a predicate from the front of an list" + assert $ (dropWhile (_ /= 1) (l [1, 2, 3])) == cel [1, 2, 3] + assert $ (dropWhile (_ /= 2) (l [1, 2, 3])) == cel [2, 3] + --assert $ (dropWhile (_ /= 1) nil) == nil + + --filter :: forall a. (a -> Boolean) -> c a -> c a + -- todo + + --filterM :: forall m a. Monad m => (a -> m Boolean) -> c a -> m (c a) + -- todo + + log "group should group consecutive equal elements into lists" + assert $ group (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1], nel [2, 2], nel [3, 3, 3], nel [1]] + + log "groupAll should group equal elements into lists" + assertSkip [SkipBrokenLazyCanEmpty] + \_ -> groupAll (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1, 1], nel [2, 2], nel [3, 3, 3]] + --assert $ groupAll (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1, 1], nel [2, 2], nel [3, 3, 3]] + + log "groupBy should group consecutive equal elements into lists based on an equivalence relation" + assert $ groupBy (eq `on` (_ `mod` 10)) (l [1, 2, 12, 3, 13, 23, 11]) == l [nel [1], nel [2, 12], nel [3, 13, 23], nel [11]] + + -- todo - wait for this to be reworked + -- log "groupAllBy should group equal elements into lists based on an comparison function" + --assert $ groupAllBy (compare `on` mod 10) (l [1, 2, 12, 3, 13, 23, 11]) == l [nel [1, 11], nel [2, 12], nel [3, 13, 23]] + + log "mapMaybe should transform every item in an list, throwing out Nothing values" + assert $ mapMaybe (\x -> if x /= 0 then Just x else Nothing) (l [0, 1, 0, 0, 2, 3]) == cel [1, 2, 3] + + log "partition should separate a list into a tuple of lists that do and do not satisfy a predicate" + let partitioned = partition (_ > 2) (l [1, 5, 3, 2, 4]) + assert $ partitioned.yes == cel [5, 3, 4] + assert $ partitioned.no == cel [1, 2] + + log "span should split an list in two based on a predicate" + let spanResult = span (_ < 4) (l [1, 2, 3, 4, 5, 6, 7]) + assert $ spanResult.init == cel [1, 2, 3] + assert $ spanResult.rest == cel [4, 5, 6, 7] + + log "take should keep the specified number of items from the front of an list, discarding the rest" + assert $ (take 1 (l [1, 2, 3])) == cel [1] + assert $ (take 2 (l [1, 2, 3])) == cel [1, 2] + --assert $ (take 1 nil) == nil + assert $ (take 0 (l [1, 2])) == nil + assert $ (take (-1) (l [1, 2])) == nil + + log "takeEnd should keep the specified number of items from the end of an list, discarding the rest" + assertSkip [SkipBrokenLazyCanEmpty] + \_ -> (takeEnd 1 (l [1, 2, 3])) == cel [3] + assertSkip [SkipBrokenLazyCanEmpty] + \_ -> (takeEnd 2 (l [1, 2, 3])) == cel [2, 3] + assertSkip [SkipBrokenLazyCanEmpty] + \_ -> (takeEnd 2 (l [1])) == cel [1] + + --assert $ (takeEnd 1 (l [1, 2, 3])) == cel [3] + --assert $ (takeEnd 2 (l [1, 2, 3])) == cel [2, 3] + ----assert $ (takeEnd 1 nil) == nil + --assert $ (takeEnd 2 (l [1])) == cel [1] + + log "takeWhile should keep all values that match a predicate from the front of an list" + assert $ (takeWhile (_ /= 2) (l [1, 2, 3])) == cel [1] + assert $ (takeWhile (_ /= 3) (l [1, 2, 3])) == cel [1, 2] + --assert $ (takeWhile (_ /= 1) nil) == nil diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 096e807..5748388 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -4,16 +4,23 @@ import Prelude import Effect (Effect) +import Test.UpdatedTests (updatedTests) + import Test.Data.List (testList) import Test.Data.List.Lazy (testListLazy) +import Test.Data.List.NonEmpty (testNonEmptyList) import Test.Data.List.Partial (testListPartial) import Test.Data.List.ZipList (testZipList) -import Test.Data.List.NonEmpty (testNonEmptyList) main :: Effect Unit main = do + --originalTests + updatedTests + +originalTests :: Effect Unit +originalTests = do testList testListLazy testZipList testListPartial - testNonEmptyList + testNonEmptyList \ No newline at end of file diff --git a/test/Test/OnlyCanEmpty.purs b/test/Test/OnlyCanEmpty.purs new file mode 100644 index 0000000..aa92d1c --- /dev/null +++ b/test/Test/OnlyCanEmpty.purs @@ -0,0 +1,170 @@ +module Test.OnlyCanEmpty where + +import Prelude + +import Control.Alternative (class Alternative) +import Control.MonadPlus (class MonadPlus) +import Control.MonadZero (class MonadZero) +import Control.Plus (class Plus, empty) +import Data.Foldable (class Foldable) +import Data.Maybe (Maybe(..), fromJust, isNothing) +import Data.Tuple (Tuple(..)) +import Data.Unfoldable (class Unfoldable, unfoldr) +import Effect (Effect) +import Effect.Console (log) +import Partial.Unsafe (unsafePartial) +import Test.Assert (assert) + +import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeContainer, range) + +import Data.List as L +import Data.List.NonEmpty as NEL +import Data.List.Lazy as LL +import Data.List.Lazy.NonEmpty as LNEL + +class ( + Alternative c + , MonadPlus c + , MonadZero c + , Monoid (c Int) -- Monoid1? + , Plus c + , Unfoldable c +) <= OnlyCanEmpty c nonEmpty | c -> nonEmpty, nonEmpty -> c where + + makeNonEmptyContainer :: forall f a. Foldable f => f a -> nonEmpty a + + -- These are the same function names as the NonEmpty versions, + -- but the signatures are different and can't be merged in the + -- CommonDiffEmptiability tests. This is due to a mismatch in the + -- presence of `Maybe`s. + fromFoldable :: forall f. Foldable f => f ~> c + head :: forall a. c a -> Maybe a + init :: forall a. c a -> Maybe (c a) + last :: forall a. c a -> Maybe a + tail :: forall a. c a -> Maybe (c a) + uncons :: forall a. c a -> Maybe { head :: a, tail :: c a } + +instance onlyCanEmptyList :: OnlyCanEmpty L.List NEL.NonEmptyList where + + makeNonEmptyContainer = unsafePartial fromJust <<< NEL.fromFoldable + + fromFoldable = L.fromFoldable + head = L.head + init = L.init + last = L.last + tail = L.tail + uncons = L.uncons + +instance onlyCanEmptyLazyList :: OnlyCanEmpty LL.List LNEL.NonEmptyList where + + makeNonEmptyContainer = unsafePartial fromJust <<< LNEL.fromFoldable + + fromFoldable = LL.fromFoldable + head = LL.head + init = LL.init + last = LL.last + tail = LL.tail + uncons = LL.uncons + + +testOnlyCanEmpty :: forall c nonEmpty. + Common c => + OnlyCanEmpty c nonEmpty => + Eq (c Int) => + Eq (c (nonEmpty Int)) => + c Int -> nonEmpty Int -> Effect Unit +testOnlyCanEmpty nil _ = do + let + l :: forall f a. Foldable f => f a -> c a + l = makeContainer + + nel :: forall f a. Foldable f => f a -> nonEmpty a + nel = makeNonEmptyContainer + + rg :: Int -> Int -> c Int + rg = range + + printTestType "Only canEmpty" + + -- ======= Typeclass tests ======== + + -- Alternative + -- applicative and plus + -- (f <|> g) <*> x == (f <*> x) <|> (g <*> x) + -- empty <*> f == empty + + -- MonadPlus + -- Additional law on MonadZero + -- (x <|> y) >>= f == (x >>= f) <|> (y >>= f) + + -- MonadZero + -- monad and alternative + -- empty >>= f = empty + + -- Monoid + -- mempty :: c + log "mempty should not change the container it is appended to" + assert $ l [5] <> mempty == l [5] + log "mempty should be an empty container" + assert $ l [] == (mempty :: c Int) + + -- Plus + -- empty :: forall a. c a + log "empty should create an empty container" + assert $ l [] == (empty :: c Int) + + -- Unfoldable + -- unfoldr :: forall a b. (b -> Maybe (Tuple a b)) -> b -> c a + + log "unfoldr should maintain order" + let + step :: Int -> Maybe (Tuple Int Int) + step 6 = Nothing + step n = Just (Tuple n (n + 1)) + assert $ rg 1 5 == unfoldr step 1 + + + -- ======= Functions tests ======== + + --fromFoldable :: forall f. Foldable f => f ~> c + --already extensively checked in common tests + + -- These are the remaining functions that can't be deduplicated due to use of Maybe + + -- Todo - double-check the phrasing on these? Might be confusing to refer to a + -- non-empty canEmpty list. + + log "head should return a Just-NEL.NonEmptyListped first value of a non-empty list" + assert $ head (l [1, 2]) == Just 1 + + log "head should return Nothing for an empty list" + assert $ head nil == Nothing + + -- Todo - phrasing should be changed to note all but last (not all but first). + log "init should return a Just-NEL.NonEmptyListped list containing all the items in an list apart from the first for a non-empty list" + assert $ init (l [1, 2, 3]) == Just (l [1, 2]) + + log "init should return Nothing for an empty list" + assert $ init nil == Nothing + + + log "last should return a Just-NEL.NonEmptyListped last value of a non-empty list" + assert $ last (l [1, 2]) == Just 2 + + log "last should return Nothing for an empty list" + assert $ last nil == Nothing + + + log "tail should return a Just-NEL.NonEmptyListped list containing all the items in an list apart from the first for a non-empty list" + assert $ tail (l [1, 2, 3]) == Just (l [2, 3]) + + log "tail should return Nothing for an empty list" + assert $ tail nil == Nothing + + + log "uncons should return nothing when used on an empty list" + assert $ isNothing (uncons nil) + + log "uncons should split an list into a head and tail record when there is at least one item" + assert $ uncons (l [1]) == Just {head: 1, tail: l []} + assert $ uncons (l [1, 2, 3]) == Just {head: 1, tail: l [2, 3]} diff --git a/test/Test/OnlyLazy.purs b/test/Test/OnlyLazy.purs new file mode 100644 index 0000000..cf211ac --- /dev/null +++ b/test/Test/OnlyLazy.purs @@ -0,0 +1,62 @@ +module Test.OnlyLazy where + +import Prelude + +import Data.Foldable (class Foldable) +import Control.Lazy (class Lazy) +import Effect (Effect) +import Effect.Console (log) +import Test.Assert (assert) + +import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeContainer) + +import Data.List.Lazy as LL +import Data.List.Lazy.NonEmpty as LNEL + +{- +class ( + Lazy (c Int) -- missing from LazyNonEmptyList +) <= OnlyLazy c where +-} + +class OnlyLazy c where + +-- Same names, but different APIs (without Maybe) + insertAt :: forall a. Int -> a -> c a -> c a + modifyAt :: forall a. Int -> (a -> a) -> c a -> c a + updateAt :: forall a. Int -> a -> c a -> c a + +instance onlyLazyList :: OnlyLazy LL.List where + insertAt = LL.insertAt + modifyAt = LL.modifyAt + updateAt = LL.updateAt + +instance onlyLazyNonEmptyList :: OnlyLazy LNEL.NonEmptyList where + insertAt = LNEL.insertAt + modifyAt = LNEL.modifyAt + updateAt = LNEL.updateAt + +testOnlyLazy :: forall c. + Common c => + OnlyLazy c => + c Int -> Effect Unit +testOnlyLazy _ = do + let + l :: forall f a. Foldable f => f a -> c a + l = makeContainer + + printTestType "Only Lazy" + + log "insertAt should add an item at the specified index" + assert $ (insertAt 0 1 (l [2, 3])) == (l [1, 2, 3]) + assert $ (insertAt 1 1 (l [2, 3])) == (l [2, 1, 3]) + assert $ (insertAt 2 1 (l [2, 3])) == (l [2, 3, 1]) + + log "modifyAt should update an item at the specified index" + assert $ (modifyAt 0 (_ + 1) (l [1, 2, 3])) == (l [2, 2, 3]) + assert $ (modifyAt 1 (_ + 1) (l [1, 2, 3])) == (l [1, 3, 3]) + + log "updateAt should replace an item at the specified index" + assert $ (updateAt 0 9 (l [1, 2, 3])) == (l [9, 2, 3]) + assert $ (updateAt 1 9 (l [1, 2, 3])) == (l [1, 9, 3]) + diff --git a/test/Test/OnlyNonEmpty.purs b/test/Test/OnlyNonEmpty.purs new file mode 100644 index 0000000..3388d7e --- /dev/null +++ b/test/Test/OnlyNonEmpty.purs @@ -0,0 +1,109 @@ +module Test.OnlyNonEmpty where + +import Prelude + +import Control.Comonad (class Comonad) +import Data.Foldable (class Foldable, foldMap, foldl) +import Data.Maybe (Maybe) +import Data.Semigroup.Foldable (class Foldable1) +import Data.Semigroup.Traversable (class Traversable1) +import Effect (Effect) +import Effect.Console (log) +import Test.Assert (assert) + +import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeContainer) + +import Data.List as L +import Data.List.Lazy as LL +import Data.List.NonEmpty as NEL +import Data.List.Lazy.NonEmpty as LNEL + +class ( + Comonad c + --, Foldable1 c -- missing from LazyNonEmptyList + --, Traversable1 c -- missing from LazyNonEmptyList +) <= OnlyNonEmpty c canEmpty | c -> canEmpty, canEmpty -> c where + + makeCanEmptyContainer :: forall f a. Foldable f => f a -> canEmpty a + + -- These are the same function names as the CanEmpty versions, + -- but the signatures are different and can't be merged in the + -- CommonDiffEmptiability tests. This is due to a mismatch in the + -- presence of `Maybe`s. + + fromFoldable :: forall f a. Foldable f => f a -> Maybe (c a) + head :: forall a. c a -> a + init :: forall a. c a -> canEmpty a + last :: forall a. c a -> a + tail :: forall a. c a -> canEmpty a + uncons :: forall a. c a -> { head :: a, tail :: canEmpty a } + + +instance onlyNonEmptyList :: OnlyNonEmpty NEL.NonEmptyList L.List where + + makeCanEmptyContainer = L.fromFoldable + + fromFoldable = NEL.fromFoldable + head = NEL.head + init = NEL.init + last = NEL.last + tail = NEL.tail + uncons = NEL.uncons + +instance onlyNonEmptyLazyList :: OnlyNonEmpty LNEL.NonEmptyList LL.List where + + makeCanEmptyContainer = LL.fromFoldable + + fromFoldable = LNEL.fromFoldable + head = LNEL.head + init = LNEL.init + last = LNEL.last + tail = LNEL.tail + uncons = LNEL.uncons + +testOnlyNonEmpty :: forall c canEmpty. + Common c => + OnlyNonEmpty c canEmpty => + Eq (c Int) => + Eq (canEmpty Int) => + c Int -> canEmpty Int -> Effect Unit +testOnlyNonEmpty _ _ = do + let + l :: forall f a. Foldable f => f a -> c a + l = makeContainer + + cel :: forall f a. Foldable f => f a -> canEmpty a + cel = makeCanEmptyContainer + + printTestType "Only nonEmpty" + + -- ======= Typeclass tests ======== + + -- Todo + + -- Comonad + -- Foldable1 + -- Traversable1 + + -- ======= Functions tests ======== + + --fromFoldable :: forall f a. Foldable f => f a -> Maybe (c a) + --already extensively checked in common tests + + -- These are the remaining functions that can't be deduplicated due to use of Maybe + + log "head should return a the first value" + assert $ head (l [1, 2]) == 1 + + log "init should return a canEmpty collection of all but the last value" + assert $ init (l [1, 2, 3]) == cel [1, 2] + + log "last should return the last value" + assert $ last (l [1, 2]) == 2 + + log "tail should return a canEmpty collection of all but the first value" + assert $ tail (l [1, 2, 3]) == cel [2, 3] + + log "uncons should split a collection into a record containing the first and remaining values" + assert $ uncons (l [1]) == {head: 1, tail: cel []} + assert $ uncons (l [1, 2, 3]) == {head: 1, tail: cel [2, 3]} \ No newline at end of file diff --git a/test/Test/OnlyStrict.purs b/test/Test/OnlyStrict.purs new file mode 100644 index 0000000..ca9db90 --- /dev/null +++ b/test/Test/OnlyStrict.purs @@ -0,0 +1,76 @@ +module Test.OnlyStrict where + +import Prelude + +import Data.Foldable (class Foldable) +import Data.Maybe (Maybe(..)) +import Effect (Effect) +import Effect.Console (log) +import Test.Assert (assert) + +import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeContainer) + +import Data.List as L +import Data.List.NonEmpty as NEL + +class OnlyStrict c where +-- Potentially just these functions: +-- Seems like they could also be common +{- +group' +mapWithIndex +sort +sortBy +unsnoc +-} + + -- Same names, but different APIs (with Maybe) + insertAt :: forall a. Int -> a -> c a -> Maybe (c a) + modifyAt :: forall a. Int -> (a -> a) -> c a -> Maybe (c a) + updateAt :: forall a. Int -> a -> c a -> Maybe (c a) + + -- Strict only + -- recently fixed, so now common + --nub :: forall a. Ord a => c a -> c a + --nubBy :: forall a. (a -> a -> Ordering) -> c a -> c a + +instance onlyStrictList :: OnlyStrict L.List where + insertAt = L.insertAt + modifyAt = L.modifyAt + updateAt = L.updateAt + +instance onlyStrictNonEmptyList :: OnlyStrict NEL.NonEmptyList where + insertAt = NEL.insertAt + modifyAt = NEL.modifyAt + updateAt = NEL.updateAt + + + +testOnlyStrict :: forall c. + Common c => + OnlyStrict c => + c Int -> Effect Unit +testOnlyStrict _ = do + + let + l :: forall f a. Foldable f => f a -> c a + l = makeContainer + + printTestType "Only Strict" + + -- todo insertAt test + -- missing from original test suite + + -- todo modifyAt test + -- missing from original test suite + + log "updateAt should replace an item at the specified index" + assert $ (updateAt 0 9 (l [1, 2, 3])) == Just (l [9, 2, 3]) + assert $ (updateAt 1 9 (l [1, 2, 3])) == Just (l [1, 9, 3]) + + log "updateAt should return Nothing if the index is out of range" + assert $ (updateAt 5 9 (l [1, 2, 3])) == Nothing + + + + diff --git a/test/Test/UpdatedTests.purs b/test/Test/UpdatedTests.purs new file mode 100644 index 0000000..24d01ab --- /dev/null +++ b/test/Test/UpdatedTests.purs @@ -0,0 +1,95 @@ +module Test.UpdatedTests(updatedTests) where + +import Prelude + +import Effect (Effect) + +import Test.Common (testCommon, SkipBroken(..), printContainerType) +import Test.CommonDiffEmptiability (testCommonDiffEmptiability) +import Test.OnlyCanEmpty(testOnlyCanEmpty) +import Test.OnlyNonEmpty(testOnlyNonEmpty) +import Test.OnlyStrict(testOnlyStrict) +import Test.OnlyLazy(testOnlyLazy) +-- +import Data.List as L +import Data.List.Lazy as LL +import Data.List.NonEmpty as NEL +import Data.List.Lazy.NonEmpty as LNEL + + +{- +--- Next steps: + +rebase +- fix "an list" -> "a list" + - or even "a container / collection" +- cleanup constraints + +-} + +updatedTests :: Effect Unit +updatedTests = do + testBasicList + testNonEmptyList + testLazyList + --testLazyNonEmptyList -- Lots of stuff to fix here + + -- testZipList + -- testListPartial + +testBasicList :: Effect Unit +testBasicList = do + + printContainerType "Basic List" + + testCommon nil + testCommonDiffEmptiability RunAll nil nil nonEmpty + testOnlyCanEmpty nil nonEmpty + testOnlyStrict nil + +testNonEmptyList :: Effect Unit +testNonEmptyList = do + + printContainerType "NonEmpty List" + + testCommon nonEmpty + testCommonDiffEmptiability RunAll nonEmpty nil nonEmpty + testOnlyNonEmpty nonEmpty nil + testOnlyStrict nonEmpty + +testLazyList :: Effect Unit +testLazyList = do + + printContainerType "Lazy List" + + testCommon lazyNil + testCommonDiffEmptiability SkipBrokenLazyCanEmpty lazyNil lazyNil lazyNonEmpty + testOnlyCanEmpty lazyNil lazyNonEmpty + testOnlyLazy lazyNil + +testLazyNonEmptyList :: Effect Unit +testLazyNonEmptyList = do + + printContainerType "Lazy NonEmpty List" + + -- So much stuff is unsupported for this container that it's not yet + -- worth using the assertSkip strategy + testCommon lazyNonEmpty + testCommonDiffEmptiability RunAll lazyNonEmpty lazyNil lazyNonEmpty + testOnlyNonEmpty lazyNonEmpty lazyNil + testOnlyLazy lazyNonEmpty + +-- nil is passed instead of a singleton, +-- because some of the functions use this +-- as a convenience value +nil :: L.List Int +nil = L.Nil + +lazyNil :: LL.List Int +lazyNil = LL.nil + +nonEmpty :: NEL.NonEmptyList Int +nonEmpty = NEL.singleton 1 + +lazyNonEmpty :: LNEL.NonEmptyList Int +lazyNonEmpty = LNEL.singleton 1 \ No newline at end of file From 45dc68ea8f7523c46b39c115b994a08df401de1b Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Thu, 22 Apr 2021 11:38:25 -0700 Subject: [PATCH 02/18] fix CI --- src/Data/List/Lazy/NonEmpty.purs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Data/List/Lazy/NonEmpty.purs b/src/Data/List/Lazy/NonEmpty.purs index 6c1c8f1..6b870c9 100644 --- a/src/Data/List/Lazy/NonEmpty.purs +++ b/src/Data/List/Lazy/NonEmpty.purs @@ -43,6 +43,7 @@ module Data.List.Lazy.NonEmpty , range , reverse , snoc + , snoc' , span , take , takeEnd From e3043d0dc6a4aae535fc57b10adc1040c5cd731f Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Fri, 23 Apr 2021 15:49:32 -0700 Subject: [PATCH 03/18] Added more common APIs and placeholders Migrating common tests on the todo list --- src/Data/List.purs | 60 ++++++++++++++++++ src/Data/List/Lazy.purs | 33 ++++++++++ src/Data/List/Lazy/NonEmpty.purs | 76 +++++++++++++++++++++++ src/Data/List/NonEmpty.purs | 61 +++++++++++++++++++ test/Test/Common.purs | 87 ++++++++++++++++++++++++--- test/Test/CommonDiffEmptiability.purs | 82 ++++++++++++++++++++----- 6 files changed, 377 insertions(+), 22 deletions(-) diff --git a/src/Data/List.purs b/src/Data/List.purs index db9c1cd..54ee40c 100644 --- a/src/Data/List.purs +++ b/src/Data/List.purs @@ -95,6 +95,15 @@ module Data.List , foldM , module Exports + + -- additions + , appendFoldable + , replicate + , replicateM + + , cons' + , snoc' + ) where import Prelude @@ -117,8 +126,59 @@ import Data.Traversable (scanl, scanr) as Exports import Data.Traversable (sequence) import Data.Tuple (Tuple(..)) import Data.Unfoldable (class Unfoldable, unfoldr) +import Partial.Unsafe (unsafeCrashWith) import Prim.TypeError (class Warn, Text) + +---------- Additions + +appendFoldable :: forall t a. Foldable t => List a -> t a -> List a +appendFoldable _ _ = unsafeCrashWith "todo appendFoldable for Basic List" +replicate :: forall a. Int -> a -> List a +replicate _ _ = unsafeCrashWith "todo replicate for Basic List" +replicateM :: forall m a. Monad m => Int -> m a -> m (List a) +replicateM _ _ = unsafeCrashWith "todo replicateM for Basic List" + + +{- +, cons' +, delete +, deleteBy +, difference +, dropEnd +, groupAllBy +, pattern +, slice +, snoc' +, stripPrefix +-} + +{- +cons' :: forall a. a -> cInverse a -> c a +cons' _ _ = unsafeCrashWith "todo cons' for todorename" +delete :: forall a. Eq a => a -> c a -> canEmpty a +delete _ _ = unsafeCrashWith "todo delete for todorename" +deleteBy :: forall a. (a -> a -> Boolean) -> a -> c a -> canEmpty a +deleteBy _ _ _ = unsafeCrashWith "todo deleteBy for todorename" +difference :: forall a. Eq a => c a -> c a -> canEmpty a +difference _ _ = unsafeCrashWith "todo difference for todorename" +dropEnd :: forall a. Int -> c a -> canEmpty a +dropEnd _ _ = unsafeCrashWith "todo dropEnd for todorename" +groupAllBy :: forall a. Ord a => (a -> a -> Boolean) -> c a -> c (nonEmpty a) +groupAllBy _ _ = unsafeCrashWith "todo groupAllBy for todorename" +slice :: Int -> Int -> c ~> canEmpty +slice _ _ = unsafeCrashWith "todo slice for todorename" +snoc' :: forall a. cInverse a -> a -> c a +snoc' _ _ = unsafeCrashWith "todo snoc' for todorename" +stripPrefix :: forall a. Eq a => Pattern a -> c a -> Maybe (canEmpty a) +stripPrefix _ _ = unsafeCrashWith "todo stripPrefix for todorename" +-} + +cons' :: forall a. a -> NEL.NonEmptyList a -> List a +cons' _ _ = unsafeCrashWith "todo cons' for Basic List" +snoc' :: forall a. NEL.NonEmptyList a -> a -> List a +snoc' _ _ = unsafeCrashWith "todo snoc' for Basic List" + -- | Convert a list into any unfoldable structure. -- | -- | Running time: `O(n)` diff --git a/src/Data/List/Lazy.purs b/src/Data/List/Lazy.purs index 9814d4b..b4c115a 100644 --- a/src/Data/List/Lazy.purs +++ b/src/Data/List/Lazy.purs @@ -96,6 +96,18 @@ module Data.List.Lazy , scanlLazy , module Exports + + -- additions + , appendFoldable + , someRec + , sort + , sortBy + + , cons' + , dropEnd + , groupAllBy + , snoc' + ) where import Prelude @@ -104,6 +116,7 @@ import Control.Alt ((<|>)) import Control.Alternative (class Alternative) import Control.Lazy as Z import Control.Monad.Rec.Class as Rec +import Control.Monad.Rec.Class (class MonadRec) import Data.Foldable (class Foldable, foldr, any, foldl) import Data.Foldable (foldl, foldr, foldMap, fold, intercalate, elem, notElem, find, findMap, any, all) as Exports import Data.Lazy (defer) @@ -119,6 +132,26 @@ import Data.Tuple (Tuple(..)) import Data.Unfoldable (class Unfoldable, unfoldr) import Partial.Unsafe (unsafeCrashWith) +-- Additions +appendFoldable :: forall t a. Foldable t => List a -> t a -> List a +appendFoldable _ _ = unsafeCrashWith "todo appendFoldable for Lazy List" +someRec :: forall f a. MonadRec f => Alternative f => f a -> f (List a) +someRec _ = unsafeCrashWith "todo someRec for Lazy List" +sort :: forall a. Ord a => List a -> List a +sort _ = unsafeCrashWith "todo sort for Lazy List" +sortBy :: forall a. (a -> a -> Ordering) -> List a -> List a +sortBy _ _ = unsafeCrashWith "todo sortBy for Lazy List" + +cons' :: forall a. a -> NEL.NonEmptyList a -> List a +cons' _ _ = unsafeCrashWith "todo cons' for Lazy List" +dropEnd :: forall a. Int -> List a -> List a +dropEnd _ _ = unsafeCrashWith "todo dropEnd for Lazy List" +groupAllBy :: forall a. Ord a => (a -> a -> Boolean) -> List a -> List (NEL.NonEmptyList a) +groupAllBy _ _ = unsafeCrashWith "todo groupAllBy for Lazy List" +snoc' :: forall a. NEL.NonEmptyList a -> a -> List a +snoc' _ _ = unsafeCrashWith "todo snoc' for Lazy List" + + -- | Convert a list into any unfoldable structure. -- | -- | Running time: `O(n)` diff --git a/src/Data/List/Lazy/NonEmpty.purs b/src/Data/List/Lazy/NonEmpty.purs index 6b870c9..af1235a 100644 --- a/src/Data/List/Lazy/NonEmpty.purs +++ b/src/Data/List/Lazy/NonEmpty.purs @@ -56,17 +56,42 @@ module Data.List.Lazy.NonEmpty , zipWith , zipWithA + , insert + , insertBy + , nub + , nubBy + , Pattern(..) + , replicate + , replicateM + , some + , someRec + , sort + , sortBy + , transpose + + , cons' + , delete + , deleteBy + , difference + , dropEnd + , groupAllBy + , slice + , stripPrefix ) where import Prelude +import Control.Alternative (class Alternative) +import Control.Lazy (class Lazy) +import Control.Monad.Rec.Class (class MonadRec) import Data.Foldable (class Foldable) import Data.Lazy (force, defer) import Data.List.Lazy ((:)) import Data.List.Lazy as L import Data.List.Lazy.Types (NonEmptyList(..)) import Data.Maybe (Maybe(..), maybe, fromMaybe) +import Data.Newtype (class Newtype) import Data.NonEmpty ((:|)) import Data.Tuple (Tuple(..)) import Data.Unfoldable (class Unfoldable, unfoldr) @@ -191,6 +216,47 @@ zipWith _ _ _ = unsafeCrashWith "todo zipWith for Lazy NonEmptyList" zipWithA :: forall m a b c. Applicative m => (a -> b -> m c) -> NonEmptyList a -> NonEmptyList b -> m (NonEmptyList c) zipWithA _ _ _ = unsafeCrashWith "todo zipWithA for Lazy NonEmptyList" + +insert :: forall a. Ord a => a -> NonEmptyList a -> NonEmptyList a +insert _ _ = unsafeCrashWith "todo insert for Lazy NonEmptyList" +insertBy :: forall a. (a -> a -> Ordering) -> a -> NonEmptyList a -> NonEmptyList a +insertBy _ _ _ = unsafeCrashWith "todo insertBy for Lazy NonEmptyList" +nub :: forall a. Ord a => NonEmptyList a -> NonEmptyList a +nub _ = unsafeCrashWith "todo nub for Lazy NonEmptyList" +nubBy :: forall a. (a -> a -> Ordering) -> NonEmptyList a -> NonEmptyList a +nubBy _ _ = unsafeCrashWith "todo nubBy for Lazy NonEmptyList" +replicate :: forall a. Int -> a -> NonEmptyList a +replicate _ _ = unsafeCrashWith "todo replicate for Lazy NonEmptyList" +replicateM :: forall m a. Monad m => Int -> m a -> m (NonEmptyList a) +replicateM _ _ = unsafeCrashWith "todo replicateM for Lazy NonEmptyList" +some :: forall f a. Alternative f => Lazy (f (NonEmptyList a)) => f a -> f (NonEmptyList a) +some _ = unsafeCrashWith "todo some for Lazy NonEmptyList" +someRec :: forall f a. MonadRec f => Alternative f => f a -> f (NonEmptyList a) +someRec _ = unsafeCrashWith "todo someRec for Lazy NonEmptyList" +sort :: forall a. Ord a => NonEmptyList a -> NonEmptyList a +sort _ = unsafeCrashWith "todo sort for Lazy NonEmptyList" +sortBy :: forall a. (a -> a -> Ordering) -> NonEmptyList a -> NonEmptyList a +sortBy _ _ = unsafeCrashWith "todo sortBy for Lazy NonEmptyList" +transpose :: forall a. NonEmptyList (NonEmptyList a) -> NonEmptyList (NonEmptyList a) +transpose _ = unsafeCrashWith "todo transpose for Lazy NonEmptyList" + +cons' :: forall a. a -> L.List a -> NonEmptyList a +cons' _ _ = unsafeCrashWith "todo cons' for LazyNonEmptyList" +delete :: forall a. Eq a => a -> NonEmptyList a -> L.List a +delete _ _ = unsafeCrashWith "todo delete for LazyNonEmptyList" +deleteBy :: forall a. (a -> a -> Boolean) -> a -> NonEmptyList a -> L.List a +deleteBy _ _ _ = unsafeCrashWith "todo deleteBy for LazyNonEmptyList" +difference :: forall a. Eq a => NonEmptyList a -> NonEmptyList a -> L.List a +difference _ _ = unsafeCrashWith "todo difference for LazyNonEmptyList" +dropEnd :: forall a. Int -> NonEmptyList a -> L.List a +dropEnd _ _ = unsafeCrashWith "todo dropEnd for LazyNonEmptyList" +groupAllBy :: forall a. Ord a => (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList (NonEmptyList a) +groupAllBy _ _ = unsafeCrashWith "todo groupAllBy for LazyNonEmptyList" +slice :: Int -> Int -> NonEmptyList ~> L.List +slice _ _ = unsafeCrashWith "todo slice for LazyNonEmptyList" +stripPrefix :: forall a. Eq a => Pattern a -> NonEmptyList a -> Maybe (L.List a) +stripPrefix _ _ = unsafeCrashWith "todo stripPrefix for LazyNonEmptyList" + ----------- toUnfoldable :: forall f. Unfoldable f => NonEmptyList ~> f @@ -251,3 +317,13 @@ concatMap = flip bind appendFoldable :: forall t a. Foldable t => NonEmptyList a -> t a -> NonEmptyList a appendFoldable nel ys = NonEmptyList (defer \_ -> head nel :| tail nel <> L.fromFoldable ys) + +-- | A newtype used in cases where there is a list to be matched. +newtype Pattern a = Pattern (NonEmptyList a) + +derive instance eqPattern :: Eq a => Eq (Pattern a) +derive instance ordPattern :: Ord a => Ord (Pattern a) +derive instance newtypePattern :: Newtype (Pattern a) _ + +instance showPattern :: Show a => Show (Pattern a) where + show (Pattern s) = "(Pattern " <> show s <> ")" diff --git a/src/Data/List/NonEmpty.purs b/src/Data/List/NonEmpty.purs index 4ff65ce..a3c634a 100644 --- a/src/Data/List/NonEmpty.purs +++ b/src/Data/List/NonEmpty.purs @@ -62,16 +62,37 @@ module Data.List.NonEmpty , unzip , foldM , module Exports + -- additions + , insert + , insertBy + , Pattern(..) + , replicate + , replicateM + , some + , someRec + , transpose + + , delete + , deleteBy + , difference + , dropEnd + , slice + , stripPrefix + ) where import Prelude +import Control.Alternative (class Alternative) +import Control.Lazy (class Lazy) +import Control.Monad.Rec.Class (class MonadRec) import Data.Foldable (class Foldable) import Data.FunctorWithIndex (mapWithIndex) as FWI import Data.List ((:)) import Data.List as L import Data.List.Types (NonEmptyList(..)) import Data.Maybe (Maybe(..), fromJust, fromMaybe, maybe) +import Data.Newtype (class Newtype) import Data.NonEmpty ((:|)) import Data.NonEmpty as NE import Data.Semigroup.Traversable (sequence1) @@ -86,6 +107,36 @@ import Data.Traversable (scanl, scanr) as Exports import Prim.TypeError (class Warn, Text) +--- Sorted additions ------ + +insert :: forall a. Ord a => a -> NonEmptyList a -> NonEmptyList a +insert _ _ = unsafeCrashWith "todo insert for NonEmptyList" +insertBy :: forall a. (a -> a -> Ordering) -> a -> NonEmptyList a -> NonEmptyList a +insertBy _ _ _ = unsafeCrashWith "todo insertBy for NonEmptyList" +replicate :: forall a. Int -> a -> NonEmptyList a +replicate _ _ = unsafeCrashWith "todo replicate for NonEmptyList" +replicateM :: forall m a. Monad m => Int -> m a -> m (NonEmptyList a) +replicateM _ _ = unsafeCrashWith "todo replicateM for NonEmptyList" +some :: forall f a. Alternative f => Lazy (f (NonEmptyList a)) => f a -> f (NonEmptyList a) +some _ = unsafeCrashWith "todo some for NonEmptyList" +someRec :: forall f a. MonadRec f => Alternative f => f a -> f (NonEmptyList a) +someRec _ = unsafeCrashWith "todo someRec for NonEmptyList" +transpose :: forall a. NonEmptyList (NonEmptyList a) -> NonEmptyList (NonEmptyList a) +transpose _ = unsafeCrashWith "todo transpose for NonEmptyList" + +delete :: forall a. Eq a => a -> NonEmptyList a -> L.List a +delete _ _ = unsafeCrashWith "todo delete for NonEmptyList" +deleteBy :: forall a. (a -> a -> Boolean) -> a -> NonEmptyList a -> L.List a +deleteBy _ _ _ = unsafeCrashWith "todo deleteBy for NonEmptyList" +difference :: forall a. Eq a => NonEmptyList a -> NonEmptyList a -> L.List a +difference _ _ = unsafeCrashWith "todo difference for NonEmptyList" +dropEnd :: forall a. Int -> NonEmptyList a -> L.List a +dropEnd _ _ = unsafeCrashWith "todo dropEnd for NonEmptyList" +slice :: Int -> Int -> NonEmptyList ~> L.List +slice _ _ = unsafeCrashWith "todo slice for NonEmptyList" +stripPrefix :: forall a. Eq a => Pattern a -> NonEmptyList a -> Maybe (L.List a) +stripPrefix _ _ = unsafeCrashWith "todo stripPrefix for NonEmptyList" + -- | Internal function: any operation on a list that is guaranteed not to delete -- | all elements also applies to a NEL, this function is a helper for defining -- | those cases. @@ -332,3 +383,13 @@ unzip ts = Tuple (map fst ts) (map snd ts) foldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> NonEmptyList a -> m b foldM f b (NonEmptyList (a :| as)) = f b a >>= \b' -> L.foldM f b' as + +-- | A newtype used in cases where there is a list to be matched. +newtype Pattern a = Pattern (NonEmptyList a) + +derive instance eqPattern :: Eq a => Eq (Pattern a) +derive instance ordPattern :: Ord a => Ord (Pattern a) +derive instance newtypePattern :: Newtype (Pattern a) _ + +instance showPattern :: Show a => Show (Pattern a) where + show (Pattern s) = "(Pattern " <> show s <> ")" diff --git a/test/Test/Common.purs b/test/Test/Common.purs index ad75a9b..1a7bcb6 100644 --- a/test/Test/Common.purs +++ b/test/Test/Common.purs @@ -3,7 +3,10 @@ module Test.Common where import Prelude import Control.Alt (class Alt, (<|>)) +import Control.Alternative (class Alternative) import Control.Extend (class Extend, (<<=)) +import Control.Lazy (class Lazy) +import Control.Monad.Rec.Class (class MonadRec) import Data.Array as Array import Data.Eq (class Eq1) import Data.Foldable (class Foldable, foldMap, foldl, sum) @@ -84,9 +87,10 @@ class ( , TraversableWithIndex Int c , Unfoldable1 c ) <= Common c where + makeContainer :: forall f a. Foldable f => f a -> c a + concat :: forall a. c (c a) -> c a concatMap :: forall a. forall b. (a -> c b) -> c a -> c b - -- Should basic list have a cons function wrapping the Cons constructor? cons :: forall a. a -> c a -> c a elemIndex :: forall a. Eq a => a -> c a -> Maybe Int elemLastIndex :: forall a. Eq a => a -> c a -> Maybe Int @@ -99,24 +103,35 @@ class ( length :: forall a. c a -> Int nubEq :: forall a. Eq a => c a -> c a nubByEq :: forall a. (a -> a -> Boolean) -> c a -> c a + range :: Int -> Int -> c Int reverse :: c ~> c singleton :: forall a. a -> c a snoc :: forall a. c a -> a -> c a toUnfoldable :: forall f a. Unfoldable f => c a -> f a union :: forall a. Eq a => c a -> c a -> c a unionBy :: forall a. (a -> a -> Boolean) -> c a -> c a -> c a - -- Types don't have to be all a - -- Todo - double check this requirement unzip :: forall a b. c (Tuple a b) -> Tuple (c a) (c b) zip :: forall a b. c a -> c b -> c (Tuple a b) zipWith :: forall a b d. (a -> b -> d) -> c a -> c b -> c d zipWithA :: forall a b d m. Applicative m => (a -> b -> m d) -> c a -> c b -> m (c d) - -- Todo - add to - -- NonEmpty - range :: Int -> Int -> c Int + appendFoldable :: forall t a. Foldable t => c a -> t a -> c a + insert :: forall a. Ord a => a -> c a -> c a + insertBy :: forall a. (a -> a -> Ordering) -> a -> c a -> c a + nub :: forall a. Ord a => c a -> c a + nubBy :: forall a. (a -> a -> Ordering) -> c a -> c a + -- This constructor is probably best to be set in diff empty + -- pattern :: forall a. (c a) -> Pattern a + replicate :: forall a. Int -> a -> c a + replicateM :: forall m a. Monad m => Int -> m a -> m (c a) + some :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) + someRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) + sort :: forall a. Ord a => c a -> c a + sortBy :: forall a. (a -> a -> Ordering) -> c a -> c a + transpose :: forall a. c (c a) -> c (c a) + + - makeContainer :: forall f a. Foldable f => f a -> c a -- Don't know how to define this in Test.Data.List -- Wrapping is tricky. @@ -125,7 +140,7 @@ instance commonList :: Common L.List where concat = L.concat concatMap = L.concatMap - cons = L.Cons + cons = L.Cons -- Should basic list have a cons function wrapping the Cons constructor? elemIndex = L.elemIndex elemLastIndex = L.elemLastIndex findIndex = L.findIndex @@ -149,6 +164,20 @@ instance commonList :: Common L.List where zipWith = L.zipWith zipWithA = L.zipWithA + appendFoldable = L.appendFoldable + insert = L.insert + insertBy = L.insertBy + nub = L.nub + nubBy = L.nubBy + -- pattern = L.Pattern + replicate = L.replicate + replicateM = L.replicateM + some = L.some + someRec = L.someRec + sort = L.sort + sortBy = L.sortBy + transpose = L.transpose + instance commonNonEmptyList :: Common NEL.NonEmptyList where makeContainer = unsafePartial fromJust <<< NEL.fromFoldable @@ -178,6 +207,20 @@ instance commonNonEmptyList :: Common NEL.NonEmptyList where zipWith = NEL.zipWith zipWithA = NEL.zipWithA + appendFoldable = NEL.appendFoldable + insert = NEL.insert + insertBy = NEL.insertBy + nub = NEL.nub + nubBy = NEL.nubBy + --pattern = NEL.Pattern + replicate = NEL.replicate + replicateM = NEL.replicateM + some = NEL.some + someRec = NEL.someRec + sort = NEL.sort + sortBy = NEL.sortBy + transpose = NEL.transpose + instance commonLazyList :: Common LL.List where makeContainer = LL.fromFoldable @@ -207,6 +250,20 @@ instance commonLazyList :: Common LL.List where zipWith = LL.zipWith zipWithA = LL.zipWithA + appendFoldable = LL.appendFoldable + insert = LL.insert + insertBy = LL.insertBy + nub = LL.nub + nubBy = LL.nubBy + --pattern = LL.Pattern + replicate = LL.replicate + replicateM = LL.replicateM + some = LL.some + someRec = LL.someRec + sort = LL.sort + sortBy = LL.sortBy + transpose = LL.transpose + instance commonLazyNonEmptyList :: Common LNEL.NonEmptyList where makeContainer = unsafePartial fromJust <<< LNEL.fromFoldable @@ -236,6 +293,20 @@ instance commonLazyNonEmptyList :: Common LNEL.NonEmptyList where zipWith = LNEL.zipWith zipWithA = LNEL.zipWithA + appendFoldable = LNEL.appendFoldable + insert = LNEL.insert + insertBy = LNEL.insertBy + nub = LNEL.nub + nubBy = LNEL.nubBy + -- pattern = LNEL.Pattern + replicate = LNEL.replicate + replicateM = LNEL.replicateM + some = LNEL.some + someRec = LNEL.someRec + sort = LNEL.sort + sortBy = LNEL.sortBy + transpose = LNEL.transpose + testCommon :: forall c. Common c => Eq (c String) => diff --git a/test/Test/CommonDiffEmptiability.purs b/test/Test/CommonDiffEmptiability.purs index c34b56b..bf15804 100644 --- a/test/Test/CommonDiffEmptiability.purs +++ b/test/Test/CommonDiffEmptiability.purs @@ -4,19 +4,17 @@ import Prelude import Data.Foldable (class Foldable) import Data.Function (on) +import Data.List as L +import Data.List.Lazy as LL +import Data.List.Lazy.NonEmpty as LNEL +import Data.List.NonEmpty as NEL import Data.Maybe (Maybe(..), fromJust) import Effect (Effect) import Effect.Console (log) import Partial.Unsafe (unsafePartial) import Test.Assert (assert) - import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeContainer, range) -import Data.List as L -import Data.List.NonEmpty as NEL -import Data.List.Lazy as LL -import Data.List.Lazy.NonEmpty as LNEL - {- This is for testing common functions that have slightly different signatures depending on whether the container may be empty or not. @@ -50,7 +48,7 @@ But creating an "identity" type alias doesn't work because: class ( Eq (c Int) -) <= CommonDiffEmptiability c canEmpty nonEmpty | c -> canEmpty nonEmpty where +) <= CommonDiffEmptiability c cInverse canEmpty nonEmpty cPattern | c -> cInverse canEmpty nonEmpty cPattern where toCanEmpty :: forall a. c a -> canEmpty a toNonEmpty :: forall a. c a -> nonEmpty a @@ -70,8 +68,20 @@ class ( takeEnd :: forall a. Int -> c a -> canEmpty a takeWhile :: forall a. (a -> Boolean) -> c a -> canEmpty a - -instance commonDiffEmptiabilityCanEmptyList :: CommonDiffEmptiability L.List L.List NEL.NonEmptyList where + cons' :: forall a. a -> cInverse a -> c a + delete :: forall a. Eq a => a -> c a -> canEmpty a + deleteBy :: forall a. (a -> a -> Boolean) -> a -> c a -> canEmpty a + difference :: forall a. Eq a => c a -> c a -> canEmpty a + dropEnd :: forall a. Int -> c a -> canEmpty a + -- There's a pending PR to update this signature + -- groupAllBy :: forall a. (a -> a -> Ordering) -> c a -> c (nonEmpty a) + groupAllBy :: forall a. Ord a => (a -> a -> Boolean) -> c a -> c (nonEmpty a) + pattern :: forall a. c a -> cPattern a + slice :: Int -> Int -> c ~> canEmpty + snoc' :: forall a. cInverse a -> a -> c a + stripPrefix :: forall a. Eq a => cPattern a -> c a -> Maybe (canEmpty a) + +instance commonDiffEmptiabilityCanEmptyList :: CommonDiffEmptiability L.List NEL.NonEmptyList L.List NEL.NonEmptyList L.Pattern where toCanEmpty = identity toNonEmpty = unsafePartial fromJust <<< NEL.fromList @@ -91,7 +101,18 @@ instance commonDiffEmptiabilityCanEmptyList :: CommonDiffEmptiability L.List L.L takeEnd = L.takeEnd takeWhile = L.takeWhile -instance commonDiffEmptiabilityNonEmptyList :: CommonDiffEmptiability NEL.NonEmptyList L.List NEL.NonEmptyList where + cons' = L.cons' + delete = L.delete + deleteBy = L.deleteBy + difference = L.difference + dropEnd = L.dropEnd + groupAllBy = L.groupAllBy + pattern = L.Pattern + slice = L.slice + snoc' = L.snoc' + stripPrefix = L.stripPrefix + +instance commonDiffEmptiabilityNonEmptyList :: CommonDiffEmptiability NEL.NonEmptyList L.List L.List NEL.NonEmptyList NEL.Pattern where toCanEmpty = NEL.toList toNonEmpty = identity @@ -111,7 +132,18 @@ instance commonDiffEmptiabilityNonEmptyList :: CommonDiffEmptiability NEL.NonEmp takeEnd = NEL.takeEnd takeWhile = NEL.takeWhile -instance commonDiffEmptiabilityCanEmptyLazyList :: CommonDiffEmptiability LL.List LL.List LNEL.NonEmptyList where + cons' = NEL.cons' + delete = NEL.delete + deleteBy = NEL.deleteBy + difference = NEL.difference + dropEnd = NEL.dropEnd + groupAllBy = NEL.groupAllBy + pattern = NEL.Pattern + slice = NEL.slice + snoc' = NEL.snoc' + stripPrefix = NEL.stripPrefix + +instance commonDiffEmptiabilityCanEmptyLazyList :: CommonDiffEmptiability LL.List LNEL.NonEmptyList LL.List LNEL.NonEmptyList LL.Pattern where toCanEmpty = identity toNonEmpty = unsafePartial fromJust <<< LNEL.fromList @@ -131,7 +163,18 @@ instance commonDiffEmptiabilityCanEmptyLazyList :: CommonDiffEmptiability LL.Lis takeEnd = LL.takeEnd takeWhile = LL.takeWhile -instance commonDiffEmptiabilityLazyNonEmptyList :: CommonDiffEmptiability LNEL.NonEmptyList LL.List LNEL.NonEmptyList where + cons' = LL.cons' + delete = LL.delete + deleteBy = LL.deleteBy + difference = LL.difference + dropEnd = LL.dropEnd + groupAllBy = LL.groupAllBy + pattern = LL.Pattern + slice = LL.slice + snoc' = LL.snoc' + stripPrefix = LL.stripPrefix + +instance commonDiffEmptiabilityLazyNonEmptyList :: CommonDiffEmptiability LNEL.NonEmptyList LL.List LL.List LNEL.NonEmptyList LNEL.Pattern where toCanEmpty = LNEL.toList toNonEmpty = identity @@ -151,9 +194,20 @@ instance commonDiffEmptiabilityLazyNonEmptyList :: CommonDiffEmptiability LNEL.N takeEnd = LNEL.takeEnd takeWhile = LNEL.takeWhile -testCommonDiffEmptiability :: forall c canEmpty nonEmpty. + cons' = LNEL.cons' + delete = LNEL.delete + deleteBy = LNEL.deleteBy + difference = LNEL.difference + dropEnd = LNEL.dropEnd + groupAllBy = LNEL.groupAllBy + pattern = LNEL.Pattern + slice = LNEL.slice + snoc' = LNEL.snoc' + stripPrefix = LNEL.stripPrefix + +testCommonDiffEmptiability :: forall c cInverse canEmpty nonEmpty cPattern. Common c => - CommonDiffEmptiability c canEmpty nonEmpty => + CommonDiffEmptiability c cInverse canEmpty nonEmpty cPattern => Eq (c (nonEmpty Int)) => Eq (canEmpty Int) => SkipBroken -> c Int -> canEmpty Int -> nonEmpty Int -> Effect Unit From 9a190dd576a659a190f62fa9f26ad1e85d07d96a Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Sat, 24 Apr 2021 10:19:53 -0700 Subject: [PATCH 04/18] remove placeholder templates --- src/Data/List.purs | 35 ----------------------------------- 1 file changed, 35 deletions(-) diff --git a/src/Data/List.purs b/src/Data/List.purs index 54ee40c..dd74e6a 100644 --- a/src/Data/List.purs +++ b/src/Data/List.purs @@ -139,41 +139,6 @@ replicate _ _ = unsafeCrashWith "todo replicate for Basic List" replicateM :: forall m a. Monad m => Int -> m a -> m (List a) replicateM _ _ = unsafeCrashWith "todo replicateM for Basic List" - -{- -, cons' -, delete -, deleteBy -, difference -, dropEnd -, groupAllBy -, pattern -, slice -, snoc' -, stripPrefix --} - -{- -cons' :: forall a. a -> cInverse a -> c a -cons' _ _ = unsafeCrashWith "todo cons' for todorename" -delete :: forall a. Eq a => a -> c a -> canEmpty a -delete _ _ = unsafeCrashWith "todo delete for todorename" -deleteBy :: forall a. (a -> a -> Boolean) -> a -> c a -> canEmpty a -deleteBy _ _ _ = unsafeCrashWith "todo deleteBy for todorename" -difference :: forall a. Eq a => c a -> c a -> canEmpty a -difference _ _ = unsafeCrashWith "todo difference for todorename" -dropEnd :: forall a. Int -> c a -> canEmpty a -dropEnd _ _ = unsafeCrashWith "todo dropEnd for todorename" -groupAllBy :: forall a. Ord a => (a -> a -> Boolean) -> c a -> c (nonEmpty a) -groupAllBy _ _ = unsafeCrashWith "todo groupAllBy for todorename" -slice :: Int -> Int -> c ~> canEmpty -slice _ _ = unsafeCrashWith "todo slice for todorename" -snoc' :: forall a. cInverse a -> a -> c a -snoc' _ _ = unsafeCrashWith "todo snoc' for todorename" -stripPrefix :: forall a. Eq a => Pattern a -> c a -> Maybe (canEmpty a) -stripPrefix _ _ = unsafeCrashWith "todo stripPrefix for todorename" --} - cons' :: forall a. a -> NEL.NonEmptyList a -> List a cons' _ _ = unsafeCrashWith "todo cons' for Basic List" snoc' :: forall a. NEL.NonEmptyList a -> a -> List a From ef11865b39fb82be8d5b2a62b6f88f24b16eb839 Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Sat, 24 Apr 2021 11:19:30 -0700 Subject: [PATCH 05/18] add common-ish alterAt deleteAt --- src/Data/List/Lazy/NonEmpty.purs | 8 +++ src/Data/List/NonEmpty.purs | 8 +++ test/Test/Main.purs | 1 + test/Test/NoOverlap.purs | 87 ++++++++++++++++++++++++++++++++ test/Test/OnlyLazy.purs | 4 ++ test/Test/OnlyStrict.purs | 3 ++ test/Test/UpdatedTests.purs | 29 ++++++----- 7 files changed, 128 insertions(+), 12 deletions(-) create mode 100644 test/Test/NoOverlap.purs diff --git a/src/Data/List/Lazy/NonEmpty.purs b/src/Data/List/Lazy/NonEmpty.purs index af1235a..1f2711a 100644 --- a/src/Data/List/Lazy/NonEmpty.purs +++ b/src/Data/List/Lazy/NonEmpty.purs @@ -77,6 +77,8 @@ module Data.List.Lazy.NonEmpty , groupAllBy , slice , stripPrefix + , deleteAt + , alterAt ) where @@ -257,6 +259,12 @@ slice _ _ = unsafeCrashWith "todo slice for LazyNonEmptyList" stripPrefix :: forall a. Eq a => Pattern a -> NonEmptyList a -> Maybe (L.List a) stripPrefix _ _ = unsafeCrashWith "todo stripPrefix for LazyNonEmptyList" +deleteAt :: forall a. Int -> NonEmptyList a -> L.List a +deleteAt _ _ = unsafeCrashWith "todo deleteAt for LazyNonEmptyList" + +alterAt :: forall a. Int -> (a -> Maybe a) -> NonEmptyList a -> NonEmptyList a +alterAt _ _ _ = unsafeCrashWith "todo alterAt for LazyNonEmptyList" + ----------- toUnfoldable :: forall f. Unfoldable f => NonEmptyList ~> f diff --git a/src/Data/List/NonEmpty.purs b/src/Data/List/NonEmpty.purs index a3c634a..10b1f93 100644 --- a/src/Data/List/NonEmpty.purs +++ b/src/Data/List/NonEmpty.purs @@ -78,6 +78,8 @@ module Data.List.NonEmpty , dropEnd , slice , stripPrefix + , deleteAt + , alterAt ) where @@ -137,6 +139,12 @@ slice _ _ = unsafeCrashWith "todo slice for NonEmptyList" stripPrefix :: forall a. Eq a => Pattern a -> NonEmptyList a -> Maybe (L.List a) stripPrefix _ _ = unsafeCrashWith "todo stripPrefix for NonEmptyList" +deleteAt :: forall a. Int -> NonEmptyList a -> Maybe (L.List a) +deleteAt _ _ = unsafeCrashWith "todo deleteAt for NonEmptyList" + +alterAt :: forall a. Int -> (a -> Maybe a) -> NonEmptyList a -> Maybe (NonEmptyList a) +alterAt _ _ _ = unsafeCrashWith "todo alterAt for NonEmptyList" + -- | Internal function: any operation on a list that is guaranteed not to delete -- | all elements also applies to a NEL, this function is a helper for defining -- | those cases. diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 5748388..e727725 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -16,6 +16,7 @@ main :: Effect Unit main = do --originalTests updatedTests + pure unit originalTests :: Effect Unit originalTests = do diff --git a/test/Test/NoOverlap.purs b/test/Test/NoOverlap.purs new file mode 100644 index 0000000..bd80db1 --- /dev/null +++ b/test/Test/NoOverlap.purs @@ -0,0 +1,87 @@ +module Test.NoOverlap where + +import Prelude + +import Effect (Effect) + +import Data.Foldable (class Foldable) +import Data.List as L +import Data.List.NonEmpty as NEL +import Data.List.Lazy as LL +import Data.List.Lazy.NonEmpty as LNEL +import Data.Maybe (Maybe(..)) + +import Test.Common (printTestType, makeContainer) + +import Effect.Console (log) +import Test.Assert (assert) + +{- +This file contains functions that cannot be tested generically. +-} + + +assertSkip :: (_ -> Boolean) -> Effect Unit +assertSkip _ = + log "...skipped" + +testOnlyStrictCanEmpty :: Effect Unit +testOnlyStrictCanEmpty = do + + let + l :: forall f a. Foldable f => f a -> L.List a + l = makeContainer + + printTestType "Only Strict canEmpty" + + log "deleteAt should remove an item at the specified index" + assert $ L.deleteAt 0 (l [1, 2, 3]) == Just (l [2, 3]) + assert $ L.deleteAt 1 (l [1, 2, 3]) == Just (l [1, 3]) + + +testOnlyStrictNonEmpty :: Effect Unit +testOnlyStrictNonEmpty = do + + let + l :: forall f a. Foldable f => f a -> NEL.NonEmptyList a + l = makeContainer + + cel :: forall f a. Foldable f => f a -> L.List a + cel = makeContainer + + printTestType "Only Strict NonEmpty" + + log "deleteAt should remove an item at the specified index" + assertSkip \_ -> NEL.deleteAt 0 (l [1, 2, 3]) == Just (cel [2, 3]) + assertSkip \_ -> NEL.deleteAt 1 (l [1, 2, 3]) == Just (cel [1, 3]) + + +testOnlyLazyCanEmpty :: Effect Unit +testOnlyLazyCanEmpty = do + + let + l :: forall f a. Foldable f => f a -> LL.List a + l = makeContainer + + printTestType "Only Lazy canEmpty" + + log "deleteAt should remove an item at the specified index" + assert $ LL.deleteAt 0 (l [1, 2, 3]) == l [2, 3] + assert $ LL.deleteAt 1 (l [1, 2, 3]) == l [1, 3] + + +testOnlyLazyNonEmpty :: Effect Unit +testOnlyLazyNonEmpty = do + + let + l :: forall f a. Foldable f => f a -> LNEL.NonEmptyList a + l = makeContainer + + cel :: forall f a. Foldable f => f a -> LL.List a + cel = makeContainer + + printTestType "Only Lazy NonEmpty" + + log "deleteAt should remove an item at the specified index" + assert $ LNEL.deleteAt 0 (l [1, 2, 3]) == cel [2, 3] + assert $ LNEL.deleteAt 1 (l [1, 2, 3]) == cel [1, 3] \ No newline at end of file diff --git a/test/Test/OnlyLazy.purs b/test/Test/OnlyLazy.purs index cf211ac..38096dd 100644 --- a/test/Test/OnlyLazy.purs +++ b/test/Test/OnlyLazy.purs @@ -3,6 +3,7 @@ module Test.OnlyLazy where import Prelude import Data.Foldable (class Foldable) +import Data.Maybe (Maybe(..)) import Control.Lazy (class Lazy) import Effect (Effect) import Effect.Console (log) @@ -22,16 +23,19 @@ class ( class OnlyLazy c where -- Same names, but different APIs (without Maybe) + alterAt :: forall a. Int -> (a -> Maybe a) -> c a -> c a insertAt :: forall a. Int -> a -> c a -> c a modifyAt :: forall a. Int -> (a -> a) -> c a -> c a updateAt :: forall a. Int -> a -> c a -> c a instance onlyLazyList :: OnlyLazy LL.List where + alterAt = LL.alterAt insertAt = LL.insertAt modifyAt = LL.modifyAt updateAt = LL.updateAt instance onlyLazyNonEmptyList :: OnlyLazy LNEL.NonEmptyList where + alterAt = LNEL.alterAt insertAt = LNEL.insertAt modifyAt = LNEL.modifyAt updateAt = LNEL.updateAt diff --git a/test/Test/OnlyStrict.purs b/test/Test/OnlyStrict.purs index ca9db90..7373d3f 100644 --- a/test/Test/OnlyStrict.purs +++ b/test/Test/OnlyStrict.purs @@ -25,6 +25,7 @@ unsnoc -} -- Same names, but different APIs (with Maybe) + alterAt :: forall a. Int -> (a -> Maybe a) -> c a -> Maybe (c a) insertAt :: forall a. Int -> a -> c a -> Maybe (c a) modifyAt :: forall a. Int -> (a -> a) -> c a -> Maybe (c a) updateAt :: forall a. Int -> a -> c a -> Maybe (c a) @@ -35,11 +36,13 @@ unsnoc --nubBy :: forall a. (a -> a -> Ordering) -> c a -> c a instance onlyStrictList :: OnlyStrict L.List where + alterAt = L.alterAt insertAt = L.insertAt modifyAt = L.modifyAt updateAt = L.updateAt instance onlyStrictNonEmptyList :: OnlyStrict NEL.NonEmptyList where + alterAt = NEL.alterAt insertAt = NEL.insertAt modifyAt = NEL.modifyAt updateAt = NEL.updateAt diff --git a/test/Test/UpdatedTests.purs b/test/Test/UpdatedTests.purs index 24d01ab..ddb2e37 100644 --- a/test/Test/UpdatedTests.purs +++ b/test/Test/UpdatedTests.purs @@ -2,19 +2,18 @@ module Test.UpdatedTests(updatedTests) where import Prelude -import Effect (Effect) - -import Test.Common (testCommon, SkipBroken(..), printContainerType) -import Test.CommonDiffEmptiability (testCommonDiffEmptiability) -import Test.OnlyCanEmpty(testOnlyCanEmpty) -import Test.OnlyNonEmpty(testOnlyNonEmpty) -import Test.OnlyStrict(testOnlyStrict) -import Test.OnlyLazy(testOnlyLazy) --- import Data.List as L import Data.List.Lazy as LL -import Data.List.NonEmpty as NEL import Data.List.Lazy.NonEmpty as LNEL +import Data.List.NonEmpty as NEL +import Effect (Effect) +import Test.Common (testCommon, SkipBroken(..), printContainerType) +import Test.CommonDiffEmptiability (testCommonDiffEmptiability) +import Test.NoOverlap (testOnlyLazyCanEmpty, testOnlyLazyNonEmpty, testOnlyStrictCanEmpty, testOnlyStrictNonEmpty) +import Test.OnlyCanEmpty (testOnlyCanEmpty) +import Test.OnlyLazy (testOnlyLazy) +import Test.OnlyNonEmpty (testOnlyNonEmpty) +import Test.OnlyStrict (testOnlyStrict) {- @@ -22,8 +21,10 @@ import Data.List.Lazy.NonEmpty as LNEL rebase - fix "an list" -> "a list" - - or even "a container / collection" -- cleanup constraints + - or even "a collection" +- rename makeContainer to makeCollection +- upgrade to assertEqual + -} @@ -46,6 +47,7 @@ testBasicList = do testCommonDiffEmptiability RunAll nil nil nonEmpty testOnlyCanEmpty nil nonEmpty testOnlyStrict nil + testOnlyStrictCanEmpty testNonEmptyList :: Effect Unit testNonEmptyList = do @@ -56,6 +58,7 @@ testNonEmptyList = do testCommonDiffEmptiability RunAll nonEmpty nil nonEmpty testOnlyNonEmpty nonEmpty nil testOnlyStrict nonEmpty + testOnlyStrictNonEmpty testLazyList :: Effect Unit testLazyList = do @@ -66,6 +69,7 @@ testLazyList = do testCommonDiffEmptiability SkipBrokenLazyCanEmpty lazyNil lazyNil lazyNonEmpty testOnlyCanEmpty lazyNil lazyNonEmpty testOnlyLazy lazyNil + testOnlyLazyCanEmpty testLazyNonEmptyList :: Effect Unit testLazyNonEmptyList = do @@ -78,6 +82,7 @@ testLazyNonEmptyList = do testCommonDiffEmptiability RunAll lazyNonEmpty lazyNil lazyNonEmpty testOnlyNonEmpty lazyNonEmpty lazyNil testOnlyLazy lazyNonEmpty + testOnlyLazyNonEmpty -- nil is passed instead of a singleton, -- because some of the functions use this From 0e0efe23a0b10e30041e7ff3a61b00c1e725d55d Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Sat, 24 Apr 2021 17:20:49 -0700 Subject: [PATCH 06/18] All crashWith placeholders added Tests todo --- src/Data/List/Lazy.purs | 3 +++ src/Data/List/Lazy/NonEmpty.purs | 11 ++++++++++ test/Test/OnlyCanEmpty.purs | 27 +++++++++++++++++------- test/Test/OnlyLazy.purs | 20 ++++++++++++++++++ test/Test/OnlyNonEmpty.purs | 36 ++++++++++++++++++++++---------- 5 files changed, 79 insertions(+), 18 deletions(-) diff --git a/src/Data/List/Lazy.purs b/src/Data/List/Lazy.purs index b4c115a..fe3dc4a 100644 --- a/src/Data/List/Lazy.purs +++ b/src/Data/List/Lazy.purs @@ -107,6 +107,7 @@ module Data.List.Lazy , dropEnd , groupAllBy , snoc' + , manyRec ) where @@ -151,6 +152,8 @@ groupAllBy _ _ = unsafeCrashWith "todo groupAllBy for Lazy List" snoc' :: forall a. NEL.NonEmptyList a -> a -> List a snoc' _ _ = unsafeCrashWith "todo snoc' for Lazy List" +manyRec :: forall f a. MonadRec f => Alternative f => f a -> f (List a) +manyRec _ = unsafeCrashWith "todo manyRec for Lazy List" -- | Convert a list into any unfoldable structure. -- | diff --git a/src/Data/List/Lazy/NonEmpty.purs b/src/Data/List/Lazy/NonEmpty.purs index 1f2711a..ce2ca21 100644 --- a/src/Data/List/Lazy/NonEmpty.purs +++ b/src/Data/List/Lazy/NonEmpty.purs @@ -80,6 +80,10 @@ module Data.List.Lazy.NonEmpty , deleteAt , alterAt + , cycle + , foldrLazy + , scanlLazy + ) where import Prelude @@ -265,6 +269,13 @@ deleteAt _ _ = unsafeCrashWith "todo deleteAt for LazyNonEmptyList" alterAt :: forall a. Int -> (a -> Maybe a) -> NonEmptyList a -> NonEmptyList a alterAt _ _ _ = unsafeCrashWith "todo alterAt for LazyNonEmptyList" +cycle :: forall a. NonEmptyList a -> NonEmptyList a +cycle _ = unsafeCrashWith "todo cycle for LazyNonEmptyList" +foldrLazy :: forall a b. Lazy b => (a -> b -> b) -> b -> NonEmptyList a -> b +foldrLazy _ _ _ = unsafeCrashWith "todo foldrLazy for LazyNonEmptyList" +scanlLazy :: forall a b. (b -> a -> b) -> b -> NonEmptyList a -> NonEmptyList b +scanlLazy _ _ _ = unsafeCrashWith "todo scanlLazy for LazyNonEmptyList" + ----------- toUnfoldable :: forall f. Unfoldable f => NonEmptyList ~> f diff --git a/test/Test/OnlyCanEmpty.purs b/test/Test/OnlyCanEmpty.purs index aa92d1c..fd0ee10 100644 --- a/test/Test/OnlyCanEmpty.purs +++ b/test/Test/OnlyCanEmpty.purs @@ -3,10 +3,16 @@ module Test.OnlyCanEmpty where import Prelude import Control.Alternative (class Alternative) +import Control.Lazy (class Lazy) +import Control.Monad.Rec.Class (class MonadRec) import Control.MonadPlus (class MonadPlus) import Control.MonadZero (class MonadZero) import Control.Plus (class Plus, empty) import Data.Foldable (class Foldable) +import Data.List as L +import Data.List.Lazy as LL +import Data.List.Lazy.NonEmpty as LNEL +import Data.List.NonEmpty as NEL import Data.Maybe (Maybe(..), fromJust, isNothing) import Data.Tuple (Tuple(..)) import Data.Unfoldable (class Unfoldable, unfoldr) @@ -14,13 +20,7 @@ import Effect (Effect) import Effect.Console (log) import Partial.Unsafe (unsafePartial) import Test.Assert (assert) - -import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeContainer, range) - -import Data.List as L -import Data.List.NonEmpty as NEL -import Data.List.Lazy as LL -import Data.List.Lazy.NonEmpty as LNEL +import Test.Common (class Common, makeContainer, printTestType, range) class ( Alternative c @@ -44,6 +44,11 @@ class ( tail :: forall a. c a -> Maybe (c a) uncons :: forall a. c a -> Maybe { head :: a, tail :: c a } + -- These are not available for non-empty collections + null :: forall a. c a -> Boolean + many :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) + manyRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) + instance onlyCanEmptyList :: OnlyCanEmpty L.List NEL.NonEmptyList where makeNonEmptyContainer = unsafePartial fromJust <<< NEL.fromFoldable @@ -55,6 +60,10 @@ instance onlyCanEmptyList :: OnlyCanEmpty L.List NEL.NonEmptyList where tail = L.tail uncons = L.uncons + null = L.null + many = L.many + manyRec = L.manyRec + instance onlyCanEmptyLazyList :: OnlyCanEmpty LL.List LNEL.NonEmptyList where makeNonEmptyContainer = unsafePartial fromJust <<< LNEL.fromFoldable @@ -66,6 +75,10 @@ instance onlyCanEmptyLazyList :: OnlyCanEmpty LL.List LNEL.NonEmptyList where tail = LL.tail uncons = LL.uncons + null = LL.null + many = LL.many + manyRec = LL.manyRec + testOnlyCanEmpty :: forall c nonEmpty. Common c => diff --git a/test/Test/OnlyLazy.purs b/test/Test/OnlyLazy.purs index 38096dd..c569ee6 100644 --- a/test/Test/OnlyLazy.purs +++ b/test/Test/OnlyLazy.purs @@ -28,18 +28,38 @@ class OnlyLazy c where modifyAt :: forall a. Int -> (a -> a) -> c a -> c a updateAt :: forall a. Int -> a -> c a -> c a + -- These are only available for Lazy collections + iterate :: forall a. (a -> a) -> a -> c a + repeat :: forall a. a -> c a + cycle :: forall a. c a -> c a + foldrLazy :: forall a b. Lazy b => (a -> b -> b) -> b -> c a -> b + scanlLazy :: forall a b. (b -> a -> b) -> b -> c a -> c b + + instance onlyLazyList :: OnlyLazy LL.List where alterAt = LL.alterAt insertAt = LL.insertAt modifyAt = LL.modifyAt updateAt = LL.updateAt + iterate = LL.iterate + repeat = LL.repeat + cycle = LL.cycle + foldrLazy = LL.foldrLazy + scanlLazy = LL.scanlLazy + instance onlyLazyNonEmptyList :: OnlyLazy LNEL.NonEmptyList where alterAt = LNEL.alterAt insertAt = LNEL.insertAt modifyAt = LNEL.modifyAt updateAt = LNEL.updateAt + iterate = LNEL.iterate + repeat = LNEL.repeat + cycle = LNEL.cycle + foldrLazy = LNEL.foldrLazy + scanlLazy = LNEL.scanlLazy + testOnlyLazy :: forall c. Common c => OnlyLazy c => diff --git a/test/Test/OnlyNonEmpty.purs b/test/Test/OnlyNonEmpty.purs index 3388d7e..9c5ae5d 100644 --- a/test/Test/OnlyNonEmpty.purs +++ b/test/Test/OnlyNonEmpty.purs @@ -4,20 +4,18 @@ import Prelude import Control.Comonad (class Comonad) import Data.Foldable (class Foldable, foldMap, foldl) -import Data.Maybe (Maybe) +import Data.List as L +import Data.List.Lazy as LL +import Data.List.Lazy.NonEmpty as LNEL +import Data.List.NonEmpty as NEL +import Data.Maybe (Maybe(..)) import Data.Semigroup.Foldable (class Foldable1) import Data.Semigroup.Traversable (class Traversable1) import Effect (Effect) import Effect.Console (log) -import Test.Assert (assert) - +import Test.Assert (assert, assertEqual) import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeContainer) -import Data.List as L -import Data.List.Lazy as LL -import Data.List.NonEmpty as NEL -import Data.List.Lazy.NonEmpty as LNEL - class ( Comonad c --, Foldable1 c -- missing from LazyNonEmptyList @@ -38,6 +36,10 @@ class ( tail :: forall a. c a -> canEmpty a uncons :: forall a. c a -> { head :: a, tail :: canEmpty a } + -- These are only available for NonEmpty collections + + fromList :: forall a. canEmpty a -> Maybe (c a) + toList :: c ~> canEmpty instance onlyNonEmptyList :: OnlyNonEmpty NEL.NonEmptyList L.List where @@ -50,6 +52,9 @@ instance onlyNonEmptyList :: OnlyNonEmpty NEL.NonEmptyList L.List where tail = NEL.tail uncons = NEL.uncons + fromList = NEL.fromList + toList = NEL.toList + instance onlyNonEmptyLazyList :: OnlyNonEmpty LNEL.NonEmptyList LL.List where makeCanEmptyContainer = LL.fromFoldable @@ -61,11 +66,15 @@ instance onlyNonEmptyLazyList :: OnlyNonEmpty LNEL.NonEmptyList LL.List where tail = LNEL.tail uncons = LNEL.uncons + fromList = LNEL.fromList + toList = LNEL.toList + testOnlyNonEmpty :: forall c canEmpty. Common c => OnlyNonEmpty c canEmpty => Eq (c Int) => Eq (canEmpty Int) => + Show (canEmpty Int) => c Int -> canEmpty Int -> Effect Unit testOnlyNonEmpty _ _ = do let @@ -87,8 +96,13 @@ testOnlyNonEmpty _ _ = do -- ======= Functions tests ======== - --fromFoldable :: forall f a. Foldable f => f a -> Maybe (c a) - --already extensively checked in common tests + log "fromList should convert from a List to a NonEmptyList" + assertEqual { actual: fromList $ cel [1, 2, 3], expected: Just $ l [1, 2, 3] } + assertEqual { actual: fromList $ cel ([] :: _ Int), expected: Nothing } + + log "toList should convert from a NonEmptyList to a List" + assertEqual { actual: toList $ l [1, 2, 3], expected: cel [1, 2, 3] } + -- These are the remaining functions that can't be deduplicated due to use of Maybe @@ -106,4 +120,4 @@ testOnlyNonEmpty _ _ = do log "uncons should split a collection into a record containing the first and remaining values" assert $ uncons (l [1]) == {head: 1, tail: cel []} - assert $ uncons (l [1, 2, 3]) == {head: 1, tail: cel [2, 3]} \ No newline at end of file + assert $ uncons (l [1, 2, 3]) == {head: 1, tail: cel [2, 3]} From c6bcc037aa735ad949461cdbc5108f0d22fe5f2f Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Sat, 24 Apr 2021 18:11:17 -0700 Subject: [PATCH 07/18] convert common tests to assertEqual --- test/Test/Common.purs | 166 +++++++++++++++++++++--------------------- 1 file changed, 82 insertions(+), 84 deletions(-) diff --git a/test/Test/Common.purs b/test/Test/Common.purs index 1a7bcb6..95d8774 100644 --- a/test/Test/Common.purs +++ b/test/Test/Common.purs @@ -14,6 +14,10 @@ import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlW import Data.Function (on) import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) import Data.Int (odd) +import Data.List as L +import Data.List.Lazy as LL +import Data.List.Lazy.NonEmpty as LNEL +import Data.List.NonEmpty as NEL import Data.Maybe (Maybe(..), fromJust) import Data.Monoid.Additive (Additive(..)) import Data.Ord (class Ord1) @@ -25,12 +29,7 @@ import Data.Unfoldable1 (class Unfoldable1, unfoldr1) import Effect (Effect) import Effect.Console (log) import Partial.Unsafe (unsafePartial) -import Test.Assert (assert) - -import Data.List as L -import Data.List.NonEmpty as NEL -import Data.List.Lazy as LL -import Data.List.Lazy.NonEmpty as LNEL +import Test.Assert (assert, assertEqual, assertEqual') {- This is temporarily being used during development. @@ -72,7 +71,7 @@ class ( , Apply c , Bind c , Eq (c Int) - --, Eq1 c -- missing from NonEmptyList, LazyNonEmptyList + , Eq1 c , Extend c , Foldable c , FoldableWithIndex Int c @@ -80,7 +79,7 @@ class ( , FunctorWithIndex Int c , Monad c , Ord (c Int) - --, Ord1 c -- missing from NonEmptyList, LazyNonEmptyList + , Ord1 c , Semigroup (c Int) , Show (c Int) , Traversable c @@ -120,8 +119,6 @@ class ( insertBy :: forall a. (a -> a -> Ordering) -> a -> c a -> c a nub :: forall a. Ord a => c a -> c a nubBy :: forall a. (a -> a -> Ordering) -> c a -> c a - -- This constructor is probably best to be set in diff empty - -- pattern :: forall a. (c a) -> Pattern a replicate :: forall a. Int -> a -> c a replicateM :: forall m a. Monad m => Int -> m a -> m (c a) some :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) @@ -312,6 +309,9 @@ testCommon :: forall c. Eq (c String) => Eq (c (Tuple Int String)) => Eq (c (c String)) => + Show (c String) => + Show (c (Tuple Int String)) => + Show (c (c String)) => c Int -> Effect Unit -- Would likely be better to pass a proxy type testCommon _ = do @@ -329,10 +329,9 @@ testCommon _ = do -- Duplicating this test out of alphabetical order, since many other tests rely on it. log "range should create an inclusive container of integers for the specified start and end" - assert $ (range 3 3) == l [3] - --assertSkip \_ -> (range 3 3) == l [3] - assert $ (range 0 5) == l [0, 1, 2, 3, 4, 5] - assert $ (range 2 (-3)) == l [2, 1, 0, -1, -2, -3] + assertEqual { actual: range 3 3, expected: l [3] } + assertEqual { actual: range 0 5, expected: l [0, 1, 2, 3, 4, 5] } + assertEqual { actual: range 2 (-3), expected: l [2, 1, 0, -1, -2, -3] } -- ======= Typeclass tests ======== @@ -340,12 +339,12 @@ testCommon _ = do -- alt :: forall a. f a -> f a -> f a -- Don't know in what situations this is different than append log "Alt's alt (<|>) should append containers" - assert $ (l [1,2] <|> l [3,4]) == l [1,2,3,4] + assertEqual { actual: l [1,2] <|> l [3,4], expected: l [1,2,3,4] } -- Applicative -- pure :: forall a. a -> f a log "Applicative's pure should construct a container with a single value" - assert $ pure 5 == l [5] + assertEqual { actual: pure 5, expected: l [5] } -- Apply -- apply :: forall a b. f (a -> b) -> f a -> f b @@ -356,15 +355,15 @@ testCommon _ = do -- bind :: forall a b. m a -> (a -> m b) -> m b log "Bind's bind (>>=) should append the results of a container-generating function\ \applied to each element in the container" - assert $ (l [1,2,3] >>= \x -> l [x,10+x]) == l [1,11,2,12,3,13] + assertEqual { actual: l [1,2,3] >>= \x -> l [x,10+x], expected: l [1,11,2,12,3,13] } -- Eq -- eq :: a -> a -> Boolean log "Eq's eq (==) should correctly test containers for equality" - assert $ l [1,2] == l [1,2] - assert $ not $ l [1,2] == l [2,2] + assertEqual' "Equality failed" { actual: l [1,2] == l [1,2], expected: true } + assertEqual' "Inequality failed" { actual: l [1,2] == l [2,2], expected: false } - -- Eq1 -- missing from NonEmptyList, LazyNonEmptyList + -- Eq1 -- eq1 :: forall a. Eq a => f a -> f a -> Boolean -- Todo @@ -373,7 +372,7 @@ testCommon _ = do log "Extend's extend (<<=) should create a container containing the results\ \of a function that is applied to increasingly smaller chunks of an input\ \container. Each iteration drops an element from the front of the input container." - assert $ (sum <<= l [1,2,3,4]) == l [10,9,7,4] + assertEqual { actual: sum <<= l [1,2,3,4], expected: l [10,9,7,4] } -- Foldable -- foldr :: forall a b. (a -> b -> b) -> b -> f a -> b @@ -388,7 +387,7 @@ testCommon _ = do void $ pure $ foldMap Additive k100 log "foldMap should be left-to-right" - assert $ foldMap show (rg 1 5) == "12345" + assertEqual { actual: foldMap show $ rg 1 5, expected: "12345" } -- FoldableWithIndex -- foldrWithIndex :: forall a b. (i -> a -> b -> b) -> b -> f a -> b @@ -397,13 +396,13 @@ testCommon _ = do -- Todo - Existing tests, opportunities for improvement log "foldlWithIndex should be correct" - assert $ foldlWithIndex (\i b _ -> i + b) 0 (rg 0 10000) == 50005000 + assertEqual { actual: foldlWithIndex (\i b _ -> i + b) 0 $ rg 0 10000, expected: 50005000 } log "foldlWithIndex should be stack-safe" void $ pure $ foldlWithIndex (\i b _ -> i + b) 0 k100 log "foldrWithIndex should be correct" - assert $ foldrWithIndex (\i _ b -> i + b) 0 (rg 0 10000) == 50005000 + assertEqual { actual: foldrWithIndex (\i _ b -> i + b) 0 $ rg 0 10000, expected: 50005000 } log "foldrWithIndex should be stack-safe" void $ pure $ foldrWithIndex (\i _ b -> i + b) 0 k100 @@ -412,20 +411,20 @@ testCommon _ = do void $ pure $ foldMapWithIndex (\i _ -> Additive i) k100 log "foldMapWithIndex should be left-to-right" - assert $ foldMapWithIndex (\i _ -> show i) (l [0, 0, 0]) == "012" + assertEqual { actual: foldMapWithIndex (\i _ -> show i) (l [0, 0, 0]), expected: "012" } -- Functor -- map :: forall a b. (a -> b) -> f a -> f b log "map should maintain order" - assert $ rg 1 5 == (map identity $ rg 1 5) + assertEqual { actual: rg 1 5, expected: map identity $ rg 1 5 } log "map should be stack-safe" void $ pure $ map identity k100 -- Todo - The below test also performs the same stack-safety check log "map should be correct" - assert $ rg 1 100000 == (map (_ + 1) $ rg 0 99999) + assertEqual { actual: rg 1 100000, expected: map (_ + 1) $ rg 0 99999 } -- FunctorWithIndex @@ -433,7 +432,7 @@ testCommon _ = do -- Todo - improve pre-existing log "mapWithIndex should take a container of values and apply a function which also takes the index into account" - assert $ mapWithIndex add (l [0, 1, 2, 3]) == l [0, 2, 4, 6] + assertEqual { actual: mapWithIndex add $ l [0, 1, 2, 3], expected: l [0, 2, 4, 6] } -- Monad -- indicates Applicative and Bind @@ -443,7 +442,7 @@ testCommon _ = do -- compare :: a -> a -> Ordering -- Todo - add tests - -- Ord1 -- missing from NonEmptyList, LazyNonEmptyList + -- Ord1 -- compare1 :: forall a. Ord a => f a -> f a -> Ordering -- Todo - add tests @@ -451,7 +450,7 @@ testCommon _ = do -- append :: a -> a -> a log "append should concatenate two containers" - assert $ (l [1, 2]) <> (l [3, 4]) == (l [1, 2, 3, 4]) + assertEqual { actual: l [1, 2] <> l [3, 4], expected: l [1, 2, 3, 4] } log "append should be stack-safe" void $ pure $ k100 <> k100 @@ -467,152 +466,151 @@ testCommon _ = do -- Todo - add sequence test log "traverse should be stack-safe" - assert $ traverse Just k100 == Just k100 + assertEqual { actual: traverse Just k100, expected: Just k100 } -- TraversableWithIndex -- traverseWithIndex :: forall a b m. Applicative m => (i -> a -> m b) -> t a -> m (t b) log "traverseWithIndex should be stack-safe" - assert $ traverseWithIndex (const Just) k100 == Just k100 + assertEqual { actual: traverseWithIndex (const Just) k100, expected: Just k100 } log "traverseWithIndex should be correct" - assert $ traverseWithIndex (\i a -> Just $ i + a) (l [2, 2, 2]) - == Just (l [2, 3, 4]) + assertEqual { actual: traverseWithIndex (\i a -> Just $ i + a) (l [2, 2, 2]), expected: Just $ l [2, 3, 4] } -- Unfoldable1 -- unfoldr1 :: forall a b. (b -> Tuple a (Maybe b)) -> b -> t a let step1 :: Int -> Tuple Int (Maybe Int) - step1 n = Tuple n (if n >= 5 then Nothing else Just (n + 1)) + step1 n = Tuple n $ if n >= 5 then Nothing else Just $ n + 1 log "unfoldr1 should maintain order" - assert $ rg 1 5 == unfoldr1 step1 1 + assertEqual { actual: rg 1 5, expected: unfoldr1 step1 1 } -- =========== Functions =========== -- Todo - split -- log "catMaybe should take a container of Maybe values and throw out Nothings" - -- assert $ catMaybes (l [Nothing, Just 2, Nothing, Just 4]) == l [2, 4] + -- assertEqual { actual: catMaybes (l [Nothing, Just 2, Nothing, Just 4]), expected: l [2, 4] } log "concat should join a container of containers" - assert $ (concat (l [l [1, 2], l [3, 4]])) == l [1, 2, 3, 4] + assertEqual { actual: concat $ l [l [1, 2], l [3, 4]], expected: l [1, 2, 3, 4] } let doubleAndOrig :: Int -> c Int doubleAndOrig x = cons (x * 2) $ singleton x log "concatMap should be equivalent to (concat <<< map)" - assert $ concatMap doubleAndOrig (l [1, 2, 3]) == concat (map doubleAndOrig (l [1, 2, 3])) + assertEqual { actual: concatMap doubleAndOrig $ l [1, 2, 3], expected: concat $ map doubleAndOrig $ l [1, 2, 3] } log "cons should add an element to the front of the container" - assert $ cons 1 (l [2, 3]) == l [1,2,3] + assertEqual { actual: cons 1 $ l [2, 3], expected: l [1,2,3] } log "elemIndex should return the index of an item that a predicate returns true for in a container" - assert $ elemIndex 1 (l [1, 2, 1]) == Just 0 - assert $ elemIndex 4 (l [1, 2, 1]) == Nothing + assertEqual { actual: elemIndex 1 $ l [1, 2, 1], expected: Just 0 } + assertEqual { actual: elemIndex 4 $ l [1, 2, 1], expected: Nothing } log "elemLastIndex should return the last index of an item in a container" - assert $ elemLastIndex 1 (l [1, 2, 1]) == Just 2 - assert $ elemLastIndex 4 (l [1, 2, 1]) == Nothing + assertEqual { actual: elemLastIndex 1 $ l [1, 2, 1], expected: Just 2 } + assertEqual { actual: elemLastIndex 4 $ l [1, 2, 1], expected: Nothing } -- Todo split -- log "filter should remove items that don't match a predicate" - -- assert $ filter odd (range 0 10) == l [1, 3, 5, 7, 9] + -- assertEqual { actual: filter odd $ range 0 10, expected: l [1, 3, 5, 7, 9] } --log "filterM should remove items that don't match a predicate while using a monadic behaviour" - --assert $ filterM (Just <<< odd) (range 0 10) == Just (l [1, 3, 5, 7, 9]) - --assert $ filterM (const Nothing) (rg 0 10) == Nothing + --assertEqual { actual: filterM (Just <<< odd) $ range 0 10, expected: Just $ l [1, 3, 5, 7, 9] } + --assertEqual { actual: filterM (const Nothing) $ rg 0 10, expected: Nothing } log "findIndex should return the index of an item that a predicate returns true for in a container" - assert $ findIndex (_ /= 1) (l [1, 2, 1]) == Just 1 - assert $ findIndex (_ == 3) (l [1, 2, 1]) == Nothing + assertEqual { actual: findIndex (_ /= 1) $ l [1, 2, 1], expected: Just 1 } + assertEqual { actual: findIndex (_ == 3) $ l [1, 2, 1], expected: Nothing } log "findLastIndex should return the last index of an item in a container" - assert $ findLastIndex (_ /= 1) (l [2, 1, 2]) == Just 2 - assert $ findLastIndex (_ == 3) (l [2, 1, 2]) == Nothing + assertEqual { actual: findLastIndex (_ /= 1) $ l [2, 1, 2], expected: Just 2 } + assertEqual { actual: findLastIndex (_ == 3) $ l [2, 1, 2], expected: Nothing } log "foldM should perform a fold using a monadic step function" - assert $ foldM (\x y -> Just (x + y)) 0 (rg 1 10) == Just 55 - assert $ foldM (\_ _ -> Nothing) 0 (rg 1 10) == Nothing + assertEqual { actual: foldM (\x y -> Just $ x + y) 0 $ rg 1 10, expected: Just 55 } + assertEqual { actual: foldM (\_ _ -> Nothing) 0 $ rg 1 10, expected: Nothing } log "index (!!) should return Just x when the index is within the bounds of the container" - assert $ l [1, 2, 3] `index` 0 == (Just 1) - assert $ l [1, 2, 3] `index` 1 == (Just 2) - assert $ l [1, 2, 3] `index` 2 == (Just 3) + assertEqual { actual: l [1, 2, 3] `index` 0, expected: Just 1 } + assertEqual { actual: l [1, 2, 3] `index` 1, expected: Just 2 } + assertEqual { actual: l [1, 2, 3] `index` 2, expected: Just 3 } log "index (!!) should return Nothing when the index is outside of the bounds of the container" - assert $ l [1, 2, 3] `index` 6 == Nothing - assert $ l [1, 2, 3] `index` (-1) == Nothing + assertEqual { actual: l [1, 2, 3] `index` 6, expected: Nothing } + assertEqual { actual: l [1, 2, 3] `index` (-1), expected: Nothing } -- todo split -- log "insertAt should add an item at the specified index" - -- assert $ (insertAt 0 1 (l [2, 3])) == Just (l [1, 2, 3]) - -- assert $ (insertAt 1 1 (l [2, 3])) == Just (l [2, 1, 3]) - -- assert $ (insertAt 2 1 (l [2, 3])) == Just (l [2, 3, 1]) + -- assertEqual { actual: insertAt 0 1 $ l [2, 3], expected: Just $ l [1, 2, 3] } + -- assertEqual { actual: insertAt 1 1 $ l [2, 3], expected: Just $ l [2, 1, 3] } + -- assertEqual { actual: insertAt 2 1 $ l [2, 3], expected: Just $ l [2, 3, 1] } -- log "insertAt should return Nothing if the index is out of range" - -- assert $ (insertAt 7 8 $ l [1,2,3]) == Nothing + -- assertEqual { actual: insertAt 7 8 $ l [1,2,3], expected: Nothing } log "intersect should return the intersection of two containers" - assert $ intersect (l [1, 2, 3, 4, 3, 2, 1]) (l [1, 1, 2, 3]) == l [1, 2, 3, 3, 2, 1] + assertEqual { actual: intersect (l [1, 2, 3, 4, 3, 2, 1]) $ l [1, 1, 2, 3], expected: l [1, 2, 3, 3, 2, 1] } log "intersectBy should return the intersection of two containers using the specified equivalence relation" - assert $ intersectBy (\x y -> (x * 2) == y) (l [1, 2, 3]) (l [2, 6]) == l [1, 3] + assertEqual { actual: intersectBy (\x y -> x * 2 == y) (l [1, 2, 3]) $ l [2, 6], expected: l [1, 3] } log "length should return the number of items in a container" - assert $ length (l [1]) == 1 - assert $ length (l [1, 2, 3, 4, 5]) == 5 + assertEqual { actual: length $ l [1], expected: 1 } + assertEqual { actual: length $ l [1, 2, 3, 4, 5], expected: 5 } log "length should be stack-safe" void $ pure $ length k100 -- todo split -- log "modifyAt should update an item at the specified index" - -- assert $ (modifyAt 0 (_ + 1) (l [1, 2, 3])) == Just (l [2, 2, 3]) - -- assert $ (modifyAt 1 (_ + 1) (l [1, 2, 3])) == Just (l [1, 3, 3]) + -- assertEqual { actual: modifyAt 0 (_ + 1) $ l [1, 2, 3], expected: Just $ l [2, 2, 3] } + -- assertEqual { actual: modifyAt 1 (_ + 1) $ l [1, 2, 3], expected: Just $ l [1, 3, 3] } -- log "modifyAt should return Nothing if the index is out of range" - -- assert $ (modifyAt 7 (_ + 1) $ l [1,2,3]) == Nothing + -- assertEqual { actual: modifyAt 7 (_ + 1) $ l [1,2,3], expected: Nothing } log "nubEq should remove duplicate elements from the container, keeping the first occurence" - assert $ nubEq (l [1, 2, 2, 3, 4, 1]) == l [1, 2, 3, 4] + assertEqual { actual: nubEq $ l [1, 2, 2, 3, 4, 1], expected: l [1, 2, 3, 4] } log "nubByEq should remove duplicate items from the container using a supplied predicate" let mod3eq = eq `on` \n -> mod n 3 - assert $ nubByEq mod3eq (l [1, 3, 4, 5, 6]) == l [1, 3, 5] + assertEqual { actual: nubByEq mod3eq $ l [1, 3, 4, 5, 6], expected: l [1, 3, 5] } log "range should create an inclusive container of integers for the specified start and end" - assert $ (range 3 3) == l [3] - assert $ (range 0 5) == l [0, 1, 2, 3, 4, 5] - assert $ (range 2 (-3)) == l [2, 1, 0, -1, -2, -3] + assertEqual { actual: range 3 3, expected: l [3] } + assertEqual { actual: range 0 5, expected: l [0, 1, 2, 3, 4, 5] } + assertEqual { actual: range 2 (-3), expected: l [2, 1, 0, -1, -2, -3] } log "reverse should reverse the order of items in a container" - assert $ (reverse (l [1, 2, 3])) == l [3, 2, 1] + assertEqual { actual: reverse $ l [1, 2, 3], expected: l [3, 2, 1] } log "singleton should construct a container with a single value" - assert $ singleton 5 == l [5] + assertEqual { actual: singleton 5, expected: l [5] } log "snoc should add an item to the end of a container" - assert $ l [1, 2, 3] `snoc` 4 == l [1, 2, 3, 4] + assertEqual { actual: l [1, 2, 3] `snoc` 4, expected: l [1, 2, 3, 4] } -- Todo toUnfoldable log "union should produce the union of two containers" - assert $ union (l [1, 2, 3]) (l [2, 3, 4]) == l [1, 2, 3, 4] - assert $ union (l [1, 1, 2, 3]) (l [2, 3, 4]) == l [1, 1, 2, 3, 4] + assertEqual { actual: union (l [1, 2, 3]) $ l [2, 3, 4], expected: l [1, 2, 3, 4] } + assertEqual { actual: union (l [1, 1, 2, 3]) $ l [2, 3, 4], expected: l [1, 1, 2, 3, 4] } log "unionBy should produce the union of two containers using the specified equality relation" - assert $ unionBy (\_ y -> y < 5) (l [1, 2, 3]) (l [2, 3, 4, 5, 6]) == l [1, 2, 3, 5, 6] + assertEqual { actual: unionBy (\_ y -> y < 5) (l [1, 2, 3]) $ l [2, 3, 4, 5, 6], expected: l [1, 2, 3, 5, 6] } log "unzip should deconstruct a container of tuples into a tuple of containers" - assert $ unzip (l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"]) == Tuple (l [1, 2, 3]) (l ["a", "b", "c"]) + assertEqual { actual: unzip $ l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"], expected: Tuple (l [1, 2, 3]) $ l ["a", "b", "c"] } log "zip should use the specified function to zip two containers together" - assert $ zip (l [1, 2, 3]) (l ["a", "b", "c"]) == l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"] + assertEqual { actual: zip (l [1, 2, 3]) $ l ["a", "b", "c"], expected: l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"] } log "zipWith should use the specified function to zip two containers together" - assert $ zipWith (\x y -> l [show x, y]) (l [1, 2, 3]) (l ["a", "b", "c"]) == l [l ["1", "a"], l ["2", "b"], l ["3", "c"]] + assertEqual { actual: zipWith (\x y -> l [show x, y]) (l [1, 2, 3]) $ l ["a", "b", "c"], expected: l [l ["1", "a"], l ["2", "b"], l ["3", "c"]] } log "zipWithA should use the specified function to zip two containers together" - assert $ zipWithA (\x y -> Just $ Tuple x y) (l [1, 2, 3]) (l ["a", "b", "c"]) == Just (l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"]) + assertEqual { actual: zipWithA (\x y -> Just $ Tuple x y) (l [1, 2, 3]) $ l ["a", "b", "c"], expected: Just $ l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"] } From dcf14e832ae65100b0f155428a50de43c3a228c6 Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Sun, 25 Apr 2021 21:05:51 -0700 Subject: [PATCH 08/18] Limit specialized replicate* to Lazy Applied some other renaming todos --- src/Data/List.purs | 6 - src/Data/List/NonEmpty.purs | 6 - test/Test/Common.purs | 213 ++++++++++++++++---------- test/Test/CommonDiffEmptiability.purs | 6 +- test/Test/Main.purs | 3 +- test/Test/NoOverlap.purs | 46 +++++- test/Test/OnlyCanEmpty.purs | 18 +-- test/Test/OnlyLazy.purs | 4 +- test/Test/OnlyNonEmpty.purs | 12 +- test/Test/OnlyStrict.purs | 4 +- test/Test/UpdatedTests.purs | 25 ++- 11 files changed, 213 insertions(+), 130 deletions(-) diff --git a/src/Data/List.purs b/src/Data/List.purs index dd74e6a..89bde1f 100644 --- a/src/Data/List.purs +++ b/src/Data/List.purs @@ -98,8 +98,6 @@ module Data.List -- additions , appendFoldable - , replicate - , replicateM , cons' , snoc' @@ -134,10 +132,6 @@ import Prim.TypeError (class Warn, Text) appendFoldable :: forall t a. Foldable t => List a -> t a -> List a appendFoldable _ _ = unsafeCrashWith "todo appendFoldable for Basic List" -replicate :: forall a. Int -> a -> List a -replicate _ _ = unsafeCrashWith "todo replicate for Basic List" -replicateM :: forall m a. Monad m => Int -> m a -> m (List a) -replicateM _ _ = unsafeCrashWith "todo replicateM for Basic List" cons' :: forall a. a -> NEL.NonEmptyList a -> List a cons' _ _ = unsafeCrashWith "todo cons' for Basic List" diff --git a/src/Data/List/NonEmpty.purs b/src/Data/List/NonEmpty.purs index 10b1f93..628d5ca 100644 --- a/src/Data/List/NonEmpty.purs +++ b/src/Data/List/NonEmpty.purs @@ -66,8 +66,6 @@ module Data.List.NonEmpty , insert , insertBy , Pattern(..) - , replicate - , replicateM , some , someRec , transpose @@ -115,10 +113,6 @@ insert :: forall a. Ord a => a -> NonEmptyList a -> NonEmptyList a insert _ _ = unsafeCrashWith "todo insert for NonEmptyList" insertBy :: forall a. (a -> a -> Ordering) -> a -> NonEmptyList a -> NonEmptyList a insertBy _ _ _ = unsafeCrashWith "todo insertBy for NonEmptyList" -replicate :: forall a. Int -> a -> NonEmptyList a -replicate _ _ = unsafeCrashWith "todo replicate for NonEmptyList" -replicateM :: forall m a. Monad m => Int -> m a -> m (NonEmptyList a) -replicateM _ _ = unsafeCrashWith "todo replicateM for NonEmptyList" some :: forall f a. Alternative f => Lazy (f (NonEmptyList a)) => f a -> f (NonEmptyList a) some _ = unsafeCrashWith "todo some for NonEmptyList" someRec :: forall f a. MonadRec f => Alternative f => f a -> f (NonEmptyList a) diff --git a/test/Test/Common.purs b/test/Test/Common.purs index 95d8774..d12bcf8 100644 --- a/test/Test/Common.purs +++ b/test/Test/Common.purs @@ -8,7 +8,7 @@ import Control.Extend (class Extend, (<<=)) import Control.Lazy (class Lazy) import Control.Monad.Rec.Class (class MonadRec) import Data.Array as Array -import Data.Eq (class Eq1) +import Data.Eq (class Eq1, eq1) import Data.Foldable (class Foldable, foldMap, foldl, sum) import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex) import Data.Function (on) @@ -24,7 +24,7 @@ import Data.Ord (class Ord1) import Data.Traversable (class Traversable, traverse) import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) import Data.Tuple (Tuple(..)) -import Data.Unfoldable (class Unfoldable, replicate, replicateA, unfoldr) +import Data.Unfoldable (class Unfoldable) import Data.Unfoldable1 (class Unfoldable1, unfoldr1) import Effect (Effect) import Effect.Console (log) @@ -35,10 +35,10 @@ import Test.Assert (assert, assertEqual, assertEqual') This is temporarily being used during development. It allows testing while still patching the API. This is passed as an additional argument to testCommon -to indicate which container type is being tested, and +to indicate which collection type is being tested, and lets us skip gaps that are currently implemented by `unsafeCrashWith`: -Once fully supported by all containers, can replace with original assert. +Once fully supported by all collections, can replace with original assert. -} data SkipBroken = SkipBrokenStrictCanEmpty @@ -55,8 +55,8 @@ assertSkipHelper skip arr f = true -> log "...skipped" false -> assert $ f unit -printContainerType :: String -> Effect Unit -printContainerType str = do +printCollectionType :: String -> Effect Unit +printCollectionType str = do log "--------------------------------" log str log "--------------------------------" @@ -86,7 +86,7 @@ class ( , TraversableWithIndex Int c , Unfoldable1 c ) <= Common c where - makeContainer :: forall f a. Foldable f => f a -> c a + makeCollection :: forall f a. Foldable f => f a -> c a concat :: forall a. c (c a) -> c a concatMap :: forall a. forall b. (a -> c b) -> c a -> c b @@ -119,8 +119,6 @@ class ( insertBy :: forall a. (a -> a -> Ordering) -> a -> c a -> c a nub :: forall a. Ord a => c a -> c a nubBy :: forall a. (a -> a -> Ordering) -> c a -> c a - replicate :: forall a. Int -> a -> c a - replicateM :: forall m a. Monad m => Int -> m a -> m (c a) some :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) someRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) sort :: forall a. Ord a => c a -> c a @@ -129,11 +127,10 @@ class ( - -- Don't know how to define this in Test.Data.List -- Wrapping is tricky. instance commonList :: Common L.List where - makeContainer = L.fromFoldable + makeCollection = L.fromFoldable concat = L.concat concatMap = L.concatMap @@ -166,9 +163,6 @@ instance commonList :: Common L.List where insertBy = L.insertBy nub = L.nub nubBy = L.nubBy - -- pattern = L.Pattern - replicate = L.replicate - replicateM = L.replicateM some = L.some someRec = L.someRec sort = L.sort @@ -176,7 +170,7 @@ instance commonList :: Common L.List where transpose = L.transpose instance commonNonEmptyList :: Common NEL.NonEmptyList where - makeContainer = unsafePartial fromJust <<< NEL.fromFoldable + makeCollection = unsafePartial fromJust <<< NEL.fromFoldable concat = NEL.concat concatMap = NEL.concatMap @@ -209,9 +203,6 @@ instance commonNonEmptyList :: Common NEL.NonEmptyList where insertBy = NEL.insertBy nub = NEL.nub nubBy = NEL.nubBy - --pattern = NEL.Pattern - replicate = NEL.replicate - replicateM = NEL.replicateM some = NEL.some someRec = NEL.someRec sort = NEL.sort @@ -219,7 +210,7 @@ instance commonNonEmptyList :: Common NEL.NonEmptyList where transpose = NEL.transpose instance commonLazyList :: Common LL.List where - makeContainer = LL.fromFoldable + makeCollection = LL.fromFoldable concat = LL.concat concatMap = LL.concatMap @@ -252,9 +243,6 @@ instance commonLazyList :: Common LL.List where insertBy = LL.insertBy nub = LL.nub nubBy = LL.nubBy - --pattern = LL.Pattern - replicate = LL.replicate - replicateM = LL.replicateM some = LL.some someRec = LL.someRec sort = LL.sort @@ -262,7 +250,7 @@ instance commonLazyList :: Common LL.List where transpose = LL.transpose instance commonLazyNonEmptyList :: Common LNEL.NonEmptyList where - makeContainer = unsafePartial fromJust <<< LNEL.fromFoldable + makeCollection = unsafePartial fromJust <<< LNEL.fromFoldable concat = LNEL.concat concatMap = LNEL.concatMap @@ -295,9 +283,6 @@ instance commonLazyNonEmptyList :: Common LNEL.NonEmptyList where insertBy = LNEL.insertBy nub = LNEL.nub nubBy = LNEL.nubBy - -- pattern = LNEL.Pattern - replicate = LNEL.replicate - replicateM = LNEL.replicateM some = LNEL.some someRec = LNEL.someRec sort = LNEL.sort @@ -309,26 +294,28 @@ testCommon :: forall c. Eq (c String) => Eq (c (Tuple Int String)) => Eq (c (c String)) => + Eq (c (Array Int)) => Show (c String) => Show (c (Tuple Int String)) => Show (c (c String)) => + Show (c (Array Int)) => c Int -> Effect Unit -- Would likely be better to pass a proxy type testCommon _ = do let l :: forall f a. Foldable f => f a -> c a - l = makeContainer + l = makeCollection rg :: Int -> Int -> c Int rg = range - k100 :: c _ - k100 = range 1 100000 + bigCollection :: c _ + bigCollection = range 1 100000 printTestType "Common" -- Duplicating this test out of alphabetical order, since many other tests rely on it. - log "range should create an inclusive container of integers for the specified start and end" + log "range should create an inclusive collection of integers for the specified start and end" assertEqual { actual: range 3 3, expected: l [3] } assertEqual { actual: range 0 5, expected: l [0, 1, 2, 3, 4, 5] } assertEqual { actual: range 2 (-3), expected: l [2, 1, 0, -1, -2, -3] } @@ -337,41 +324,48 @@ testCommon _ = do -- Alt -- alt :: forall a. f a -> f a -> f a - -- Don't know in what situations this is different than append - log "Alt's alt (<|>) should append containers" + -- Todo - Don't know in what situations this is different than append + log "Alt's alt (<|>) should append collections" assertEqual { actual: l [1,2] <|> l [3,4], expected: l [1,2,3,4] } -- Applicative -- pure :: forall a. a -> f a - log "Applicative's pure should construct a container with a single value" + log "Applicative's pure should construct a collection with a single value" assertEqual { actual: pure 5, expected: l [5] } -- Apply -- apply :: forall a b. f (a -> b) -> f a -> f b - -- Todo - pass in a helper container of functions - -- or function that creates a container of functions + log "Apply's apply (<*>) should have cartesian product behavior for non-zippy collections" + log "... skipped" + -- Todo - make these consistent and also double-check for arrays + -- can-empty behavior + -- assertEqual { actual: makeCollection [mul 10, mul 100] <*> l [1, 2, 3], expected: l [10, 20, 30, 100, 200, 300] } + -- NonEmpty behavior + -- assertEqual { actual: makeCollection [mul 10, mul 100] <*> l [1, 2, 3], expected: l [10, 100, 20, 200, 30, 300] } -- Bind c -- bind :: forall a b. m a -> (a -> m b) -> m b - log "Bind's bind (>>=) should append the results of a container-generating function\ - \applied to each element in the container" + log "Bind's bind (>>=) should append the results of a collection-generating function\ + \applied to each element in the collection" assertEqual { actual: l [1,2,3] >>= \x -> l [x,10+x], expected: l [1,11,2,12,3,13] } -- Eq -- eq :: a -> a -> Boolean - log "Eq's eq (==) should correctly test containers for equality" + log "Eq's eq (==) should correctly test collections for equality" assertEqual' "Equality failed" { actual: l [1,2] == l [1,2], expected: true } assertEqual' "Inequality failed" { actual: l [1,2] == l [2,2], expected: false } -- Eq1 -- eq1 :: forall a. Eq a => f a -> f a -> Boolean - -- Todo + log "Eq1's eq1 should correctly test collections for equality" + assertEqual' "Equality failed" { actual: l [1,2] `eq1` l [1,2], expected: true } + assertEqual' "Inequality failed" { actual: l [1,2] `eq1` l [2,2], expected: false } -- Extend -- extend :: forall b a. (w a -> b) -> w a -> w b - log "Extend's extend (<<=) should create a container containing the results\ + log "Extend's extend (<<=) should create a collection containing the results\ \of a function that is applied to increasingly smaller chunks of an input\ - \container. Each iteration drops an element from the front of the input container." + \collection. Each iteration drops an element from the front of the input collection." assertEqual { actual: sum <<= l [1,2,3,4], expected: l [10,9,7,4] } -- Foldable @@ -381,10 +375,10 @@ testCommon _ = do -- These are just the pre-existing tests. They could be more comprehensive. log "foldl should be stack-safe" - void $ pure $ foldl (+) 0 k100 + void $ pure $ foldl (+) 0 bigCollection log "foldMap should be stack-safe" - void $ pure $ foldMap Additive k100 + void $ pure $ foldMap Additive bigCollection log "foldMap should be left-to-right" assertEqual { actual: foldMap show $ rg 1 5, expected: "12345" } @@ -399,16 +393,16 @@ testCommon _ = do assertEqual { actual: foldlWithIndex (\i b _ -> i + b) 0 $ rg 0 10000, expected: 50005000 } log "foldlWithIndex should be stack-safe" - void $ pure $ foldlWithIndex (\i b _ -> i + b) 0 k100 + void $ pure $ foldlWithIndex (\i b _ -> i + b) 0 bigCollection log "foldrWithIndex should be correct" assertEqual { actual: foldrWithIndex (\i _ b -> i + b) 0 $ rg 0 10000, expected: 50005000 } log "foldrWithIndex should be stack-safe" - void $ pure $ foldrWithIndex (\i _ b -> i + b) 0 k100 + void $ pure $ foldrWithIndex (\i _ b -> i + b) 0 bigCollection log "foldMapWithIndex should be stack-safe" - void $ pure $ foldMapWithIndex (\i _ -> Additive i) k100 + void $ pure $ foldMapWithIndex (\i _ -> Additive i) bigCollection log "foldMapWithIndex should be left-to-right" assertEqual { actual: foldMapWithIndex (\i _ -> show i) (l [0, 0, 0]), expected: "012" } @@ -420,7 +414,7 @@ testCommon _ = do assertEqual { actual: rg 1 5, expected: map identity $ rg 1 5 } log "map should be stack-safe" - void $ pure $ map identity k100 + void $ pure $ map identity bigCollection -- Todo - The below test also performs the same stack-safety check log "map should be correct" @@ -431,12 +425,11 @@ testCommon _ = do -- mapWithIndex :: forall a b. (i -> a -> b) -> f a -> f b -- Todo - improve pre-existing - log "mapWithIndex should take a container of values and apply a function which also takes the index into account" + log "mapWithIndex should take a collection of values and apply a function which also takes the index into account" assertEqual { actual: mapWithIndex add $ l [0, 1, 2, 3], expected: l [0, 2, 4, 6] } -- Monad - -- indicates Applicative and Bind - -- No specific tests + -- Indicates Applicative and Bind, which are already tested -- Ord -- compare :: a -> a -> Ordering @@ -449,11 +442,11 @@ testCommon _ = do -- Semigroup -- append :: a -> a -> a - log "append should concatenate two containers" + log "append should concatenate two collections" assertEqual { actual: l [1, 2] <> l [3, 4], expected: l [1, 2, 3, 4] } log "append should be stack-safe" - void $ pure $ k100 <> k100 + void $ pure $ bigCollection <> bigCollection -- Show -- show :: a -> String @@ -466,13 +459,13 @@ testCommon _ = do -- Todo - add sequence test log "traverse should be stack-safe" - assertEqual { actual: traverse Just k100, expected: Just k100 } + assertEqual { actual: traverse Just bigCollection, expected: Just bigCollection } -- TraversableWithIndex -- traverseWithIndex :: forall a b m. Applicative m => (i -> a -> m b) -> t a -> m (t b) log "traverseWithIndex should be stack-safe" - assertEqual { actual: traverseWithIndex (const Just) k100, expected: Just k100 } + assertEqual { actual: traverseWithIndex (const Just) bigCollection, expected: Just bigCollection } log "traverseWithIndex should be correct" assertEqual { actual: traverseWithIndex (\i a -> Just $ i + a) (l [2, 2, 2]), expected: Just $ l [2, 3, 4] } @@ -490,10 +483,10 @@ testCommon _ = do -- =========== Functions =========== -- Todo - split - -- log "catMaybe should take a container of Maybe values and throw out Nothings" + -- log "catMaybe should take a collection of Maybe values and throw out Nothings" -- assertEqual { actual: catMaybes (l [Nothing, Just 2, Nothing, Just 4]), expected: l [2, 4] } - log "concat should join a container of containers" + log "concat should join a collection of collections" assertEqual { actual: concat $ l [l [1, 2], l [3, 4]], expected: l [1, 2, 3, 4] } let @@ -503,14 +496,14 @@ testCommon _ = do log "concatMap should be equivalent to (concat <<< map)" assertEqual { actual: concatMap doubleAndOrig $ l [1, 2, 3], expected: concat $ map doubleAndOrig $ l [1, 2, 3] } - log "cons should add an element to the front of the container" + log "cons should add an element to the front of the collection" assertEqual { actual: cons 1 $ l [2, 3], expected: l [1,2,3] } - log "elemIndex should return the index of an item that a predicate returns true for in a container" + log "elemIndex should return the index of an item that a predicate returns true for in a collection" assertEqual { actual: elemIndex 1 $ l [1, 2, 1], expected: Just 0 } assertEqual { actual: elemIndex 4 $ l [1, 2, 1], expected: Nothing } - log "elemLastIndex should return the last index of an item in a container" + log "elemLastIndex should return the last index of an item in a collection" assertEqual { actual: elemLastIndex 1 $ l [1, 2, 1], expected: Just 2 } assertEqual { actual: elemLastIndex 4 $ l [1, 2, 1], expected: Nothing } @@ -522,11 +515,11 @@ testCommon _ = do --assertEqual { actual: filterM (Just <<< odd) $ range 0 10, expected: Just $ l [1, 3, 5, 7, 9] } --assertEqual { actual: filterM (const Nothing) $ rg 0 10, expected: Nothing } - log "findIndex should return the index of an item that a predicate returns true for in a container" + log "findIndex should return the index of an item that a predicate returns true for in a collection" assertEqual { actual: findIndex (_ /= 1) $ l [1, 2, 1], expected: Just 1 } assertEqual { actual: findIndex (_ == 3) $ l [1, 2, 1], expected: Nothing } - log "findLastIndex should return the last index of an item in a container" + log "findLastIndex should return the last index of an item in a collection" assertEqual { actual: findLastIndex (_ /= 1) $ l [2, 1, 2], expected: Just 2 } assertEqual { actual: findLastIndex (_ == 3) $ l [2, 1, 2], expected: Nothing } @@ -534,12 +527,12 @@ testCommon _ = do assertEqual { actual: foldM (\x y -> Just $ x + y) 0 $ rg 1 10, expected: Just 55 } assertEqual { actual: foldM (\_ _ -> Nothing) 0 $ rg 1 10, expected: Nothing } - log "index (!!) should return Just x when the index is within the bounds of the container" + log "index (!!) should return Just x when the index is within the bounds of the collection" assertEqual { actual: l [1, 2, 3] `index` 0, expected: Just 1 } assertEqual { actual: l [1, 2, 3] `index` 1, expected: Just 2 } assertEqual { actual: l [1, 2, 3] `index` 2, expected: Just 3 } - log "index (!!) should return Nothing when the index is outside of the bounds of the container" + log "index (!!) should return Nothing when the index is outside of the bounds of the collection" assertEqual { actual: l [1, 2, 3] `index` 6, expected: Nothing } assertEqual { actual: l [1, 2, 3] `index` (-1), expected: Nothing } @@ -552,18 +545,18 @@ testCommon _ = do -- log "insertAt should return Nothing if the index is out of range" -- assertEqual { actual: insertAt 7 8 $ l [1,2,3], expected: Nothing } - log "intersect should return the intersection of two containers" + log "intersect should return the intersection of two collections" assertEqual { actual: intersect (l [1, 2, 3, 4, 3, 2, 1]) $ l [1, 1, 2, 3], expected: l [1, 2, 3, 3, 2, 1] } - log "intersectBy should return the intersection of two containers using the specified equivalence relation" + log "intersectBy should return the intersection of two collections using the specified equivalence relation" assertEqual { actual: intersectBy (\x y -> x * 2 == y) (l [1, 2, 3]) $ l [2, 6], expected: l [1, 3] } - log "length should return the number of items in a container" + log "length should return the number of items in a collection" assertEqual { actual: length $ l [1], expected: 1 } assertEqual { actual: length $ l [1, 2, 3, 4, 5], expected: 5 } log "length should be stack-safe" - void $ pure $ length k100 + void $ pure $ length bigCollection -- todo split -- log "modifyAt should update an item at the specified index" @@ -573,44 +566,106 @@ testCommon _ = do -- log "modifyAt should return Nothing if the index is out of range" -- assertEqual { actual: modifyAt 7 (_ + 1) $ l [1,2,3], expected: Nothing } - log "nubEq should remove duplicate elements from the container, keeping the first occurence" + log "nubEq should remove duplicate elements from the collection, keeping the first occurence" assertEqual { actual: nubEq $ l [1, 2, 2, 3, 4, 1], expected: l [1, 2, 3, 4] } - log "nubByEq should remove duplicate items from the container using a supplied predicate" + log "nubByEq should remove duplicate items from the collection using a supplied predicate" let mod3eq = eq `on` \n -> mod n 3 assertEqual { actual: nubByEq mod3eq $ l [1, 3, 4, 5, 6], expected: l [1, 3, 5] } - log "range should create an inclusive container of integers for the specified start and end" + log "range should create an inclusive collection of integers for the specified start and end" assertEqual { actual: range 3 3, expected: l [3] } assertEqual { actual: range 0 5, expected: l [0, 1, 2, 3, 4, 5] } assertEqual { actual: range 2 (-3), expected: l [2, 1, 0, -1, -2, -3] } - log "reverse should reverse the order of items in a container" + log "reverse should reverse the order of items in a collection" assertEqual { actual: reverse $ l [1, 2, 3], expected: l [3, 2, 1] } - log "singleton should construct a container with a single value" + log "singleton should construct a collection with a single value" assertEqual { actual: singleton 5, expected: l [5] } - log "snoc should add an item to the end of a container" + log "snoc should add an item to the end of a collection" assertEqual { actual: l [1, 2, 3] `snoc` 4, expected: l [1, 2, 3, 4] } -- Todo toUnfoldable - log "union should produce the union of two containers" + log "union should produce the union of two collections" assertEqual { actual: union (l [1, 2, 3]) $ l [2, 3, 4], expected: l [1, 2, 3, 4] } assertEqual { actual: union (l [1, 1, 2, 3]) $ l [2, 3, 4], expected: l [1, 1, 2, 3, 4] } - log "unionBy should produce the union of two containers using the specified equality relation" + log "unionBy should produce the union of two collections using the specified equality relation" assertEqual { actual: unionBy (\_ y -> y < 5) (l [1, 2, 3]) $ l [2, 3, 4, 5, 6], expected: l [1, 2, 3, 5, 6] } - log "unzip should deconstruct a container of tuples into a tuple of containers" + log "unzip should deconstruct a collection of tuples into a tuple of collections" assertEqual { actual: unzip $ l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"], expected: Tuple (l [1, 2, 3]) $ l ["a", "b", "c"] } - log "zip should use the specified function to zip two containers together" + log "zip should use the specified function to zip two collections together" assertEqual { actual: zip (l [1, 2, 3]) $ l ["a", "b", "c"], expected: l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"] } - log "zipWith should use the specified function to zip two containers together" + log "zipWith should use the specified function to zip two collections together" assertEqual { actual: zipWith (\x y -> l [show x, y]) (l [1, 2, 3]) $ l ["a", "b", "c"], expected: l [l ["1", "a"], l ["2", "b"], l ["3", "c"]] } - log "zipWithA should use the specified function to zip two containers together" + log "zipWithA should use the specified function to zip two collections together" assertEqual { actual: zipWithA (\x y -> Just $ Tuple x y) (l [1, 2, 3]) $ l ["a", "b", "c"], expected: Just $ l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"] } + + {- + New stuff + Todo: + -- convert to assertEqual + -- sort into above + -} + + -- appendFoldable :: forall t a. Foldable t => c a -> t a -> c a + -- todo + + {- + -- Todo - clean these up + + log "insert should add an item at the appropriate place in a sorted list" + assert $ insert 2 (l [1, 1, 3]) == l [1, 1, 2, 3] + assert $ insert 4 (l [1, 2, 3]) == l [1, 2, 3, 4] + assert $ insert 0 (l [1, 2, 3]) == l [0, 1, 2, 3] + + log "insertBy should add an item at the appropriate place in a sorted list using the specified comparison" + assert $ insertBy (flip compare) 4 (l [1, 2, 3]) == l [4, 1, 2, 3] + assert $ insertBy (flip compare) 0 (l [1, 2, 3]) == l [1, 2, 3, 0] + + -- nub :: forall a. Ord a => c a -> c a + -- nubBy :: forall a. (a -> a -> Ordering) -> c a -> c a + + log "nub should remove duplicate elements from the list, keeping the first occurrence" + assert $ nub (l [1, 2, 2, 3, 4, 1]) == l [1, 2, 3, 4] + + log "nubBy should remove duplicate items from the list using a supplied predicate" + assert $ nubBy (compare `on` Array.length) (l [[1],[2],[3,4]]) == l [[1],[3,4]] + -} + + + {- + -- replicate :: forall a. Int -> a -> c a + log "unfoldable replicate should be stack-safe" + void $ pure $ length $ replicate 100000 1 + + log "replicate should produce an list containing an item a specified number of times" + assert $ replicate 3 true == l [true, true, true] + assert $ replicate 1 "foo" == l ["foo"] + assert $ replicate 0 "foo" == l [] + assert $ replicate (-1) "foo" == l [] + + log "replicateA should perform the monadic action the correct number of times" + assert $ replicateA 3 (Just 1) == Just (l [1, 1, 1]) + assert $ replicateA 1 (Just 1) == Just (l [1]) + assert $ replicateA 0 (Just 1) == Just (l []) + assert $ replicateA (-1) (Just 1) == Just (l []) + -} + + + + + -- replicateM :: forall m a. Monad m => Int -> m a -> m (c a) + -- some :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) + -- someRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) + -- sort :: forall a. Ord a => c a -> c a + -- sortBy :: forall a. (a -> a -> Ordering) -> c a -> c a + -- transpose :: forall a. c (c a) -> c (c a) + diff --git a/test/Test/CommonDiffEmptiability.purs b/test/Test/CommonDiffEmptiability.purs index bf15804..bd37bba 100644 --- a/test/Test/CommonDiffEmptiability.purs +++ b/test/Test/CommonDiffEmptiability.purs @@ -13,11 +13,11 @@ import Effect (Effect) import Effect.Console (log) import Partial.Unsafe (unsafePartial) import Test.Assert (assert) -import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeContainer, range) +import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeCollection, range) {- This is for testing common functions that have slightly different -signatures depending on whether the container may be empty or not. +signatures depending on whether the collection may be empty or not. For example: CanEmpty (as `c`): drop :: forall a. Int -> c a -> c a @@ -214,7 +214,7 @@ testCommonDiffEmptiability :: forall c cInverse canEmpty nonEmpty cPattern. testCommonDiffEmptiability skip _ nil _ = do let l :: forall f a. Foldable f => f a -> c a - l = makeContainer + l = makeCollection cel :: forall f a. Foldable f => f a -> canEmpty a cel = toCanEmpty <<< l diff --git a/test/Test/Main.purs b/test/Test/Main.purs index e727725..552577a 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -24,4 +24,5 @@ originalTests = do testListLazy testZipList testListPartial - testNonEmptyList \ No newline at end of file + testNonEmptyList + -- Missing testLazyNonEmptyList \ No newline at end of file diff --git a/test/Test/NoOverlap.purs b/test/Test/NoOverlap.purs index bd80db1..f563fa3 100644 --- a/test/Test/NoOverlap.purs +++ b/test/Test/NoOverlap.purs @@ -11,7 +11,7 @@ import Data.List.Lazy as LL import Data.List.Lazy.NonEmpty as LNEL import Data.Maybe (Maybe(..)) -import Test.Common (printTestType, makeContainer) +import Test.Common (printTestType, makeCollection) import Effect.Console (log) import Test.Assert (assert) @@ -30,58 +30,88 @@ testOnlyStrictCanEmpty = do let l :: forall f a. Foldable f => f a -> L.List a - l = makeContainer + l = makeCollection printTestType "Only Strict canEmpty" + -- Common function names, but different signatures + log "deleteAt should remove an item at the specified index" assert $ L.deleteAt 0 (l [1, 2, 3]) == Just (l [2, 3]) assert $ L.deleteAt 1 (l [1, 2, 3]) == Just (l [1, 3]) + -- Corner Cases + + -- Unique functions + testOnlyStrictNonEmpty :: Effect Unit testOnlyStrictNonEmpty = do let l :: forall f a. Foldable f => f a -> NEL.NonEmptyList a - l = makeContainer + l = makeCollection cel :: forall f a. Foldable f => f a -> L.List a - cel = makeContainer + cel = makeCollection printTestType "Only Strict NonEmpty" + -- Common function names, but different signatures + log "deleteAt should remove an item at the specified index" assertSkip \_ -> NEL.deleteAt 0 (l [1, 2, 3]) == Just (cel [2, 3]) assertSkip \_ -> NEL.deleteAt 1 (l [1, 2, 3]) == Just (cel [1, 3]) + -- Corner Cases + + -- Unique functions + testOnlyLazyCanEmpty :: Effect Unit testOnlyLazyCanEmpty = do let l :: forall f a. Foldable f => f a -> LL.List a - l = makeContainer + l = makeCollection printTestType "Only Lazy canEmpty" + -- Common function names, but different signatures + log "deleteAt should remove an item at the specified index" assert $ LL.deleteAt 0 (l [1, 2, 3]) == l [2, 3] assert $ LL.deleteAt 1 (l [1, 2, 3]) == l [1, 3] + -- Corner Cases + + -- Unique functions + + -- replicate (specialized from Unfoldable's replicate) + -- replicateM (specialized from Unfoldable's replicateA) + testOnlyLazyNonEmpty :: Effect Unit testOnlyLazyNonEmpty = do let l :: forall f a. Foldable f => f a -> LNEL.NonEmptyList a - l = makeContainer + l = makeCollection cel :: forall f a. Foldable f => f a -> LL.List a - cel = makeContainer + cel = makeCollection printTestType "Only Lazy NonEmpty" + -- Common function names, but different signatures + log "deleteAt should remove an item at the specified index" assert $ LNEL.deleteAt 0 (l [1, 2, 3]) == cel [2, 3] - assert $ LNEL.deleteAt 1 (l [1, 2, 3]) == cel [1, 3] \ No newline at end of file + assert $ LNEL.deleteAt 1 (l [1, 2, 3]) == cel [1, 3] + + -- Corner Cases + + -- Unique functions + + -- replicate1 (specialized from Unfoldable1's replicate1) + -- replicate1M (specialized from Unfoldable1's replicate1A) \ No newline at end of file diff --git a/test/Test/OnlyCanEmpty.purs b/test/Test/OnlyCanEmpty.purs index fd0ee10..8f87b49 100644 --- a/test/Test/OnlyCanEmpty.purs +++ b/test/Test/OnlyCanEmpty.purs @@ -20,7 +20,7 @@ import Effect (Effect) import Effect.Console (log) import Partial.Unsafe (unsafePartial) import Test.Assert (assert) -import Test.Common (class Common, makeContainer, printTestType, range) +import Test.Common (class Common, makeCollection, printTestType, range) class ( Alternative c @@ -31,7 +31,7 @@ class ( , Unfoldable c ) <= OnlyCanEmpty c nonEmpty | c -> nonEmpty, nonEmpty -> c where - makeNonEmptyContainer :: forall f a. Foldable f => f a -> nonEmpty a + makeNonEmptyCollection :: forall f a. Foldable f => f a -> nonEmpty a -- These are the same function names as the NonEmpty versions, -- but the signatures are different and can't be merged in the @@ -51,7 +51,7 @@ class ( instance onlyCanEmptyList :: OnlyCanEmpty L.List NEL.NonEmptyList where - makeNonEmptyContainer = unsafePartial fromJust <<< NEL.fromFoldable + makeNonEmptyCollection = unsafePartial fromJust <<< NEL.fromFoldable fromFoldable = L.fromFoldable head = L.head @@ -66,7 +66,7 @@ instance onlyCanEmptyList :: OnlyCanEmpty L.List NEL.NonEmptyList where instance onlyCanEmptyLazyList :: OnlyCanEmpty LL.List LNEL.NonEmptyList where - makeNonEmptyContainer = unsafePartial fromJust <<< LNEL.fromFoldable + makeNonEmptyCollection = unsafePartial fromJust <<< LNEL.fromFoldable fromFoldable = LL.fromFoldable head = LL.head @@ -89,10 +89,10 @@ testOnlyCanEmpty :: forall c nonEmpty. testOnlyCanEmpty nil _ = do let l :: forall f a. Foldable f => f a -> c a - l = makeContainer + l = makeCollection nel :: forall f a. Foldable f => f a -> nonEmpty a - nel = makeNonEmptyContainer + nel = makeNonEmptyCollection rg :: Int -> Int -> c Int rg = range @@ -116,14 +116,14 @@ testOnlyCanEmpty nil _ = do -- Monoid -- mempty :: c - log "mempty should not change the container it is appended to" + log "mempty should not change the collection it is appended to" assert $ l [5] <> mempty == l [5] - log "mempty should be an empty container" + log "mempty should be an empty collection" assert $ l [] == (mempty :: c Int) -- Plus -- empty :: forall a. c a - log "empty should create an empty container" + log "empty should create an empty collection" assert $ l [] == (empty :: c Int) -- Unfoldable diff --git a/test/Test/OnlyLazy.purs b/test/Test/OnlyLazy.purs index c569ee6..2b4a66c 100644 --- a/test/Test/OnlyLazy.purs +++ b/test/Test/OnlyLazy.purs @@ -9,7 +9,7 @@ import Effect (Effect) import Effect.Console (log) import Test.Assert (assert) -import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeContainer) +import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeCollection) import Data.List.Lazy as LL import Data.List.Lazy.NonEmpty as LNEL @@ -67,7 +67,7 @@ testOnlyLazy :: forall c. testOnlyLazy _ = do let l :: forall f a. Foldable f => f a -> c a - l = makeContainer + l = makeCollection printTestType "Only Lazy" diff --git a/test/Test/OnlyNonEmpty.purs b/test/Test/OnlyNonEmpty.purs index 9c5ae5d..cbd17cc 100644 --- a/test/Test/OnlyNonEmpty.purs +++ b/test/Test/OnlyNonEmpty.purs @@ -14,7 +14,7 @@ import Data.Semigroup.Traversable (class Traversable1) import Effect (Effect) import Effect.Console (log) import Test.Assert (assert, assertEqual) -import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeContainer) +import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeCollection) class ( Comonad c @@ -22,7 +22,7 @@ class ( --, Traversable1 c -- missing from LazyNonEmptyList ) <= OnlyNonEmpty c canEmpty | c -> canEmpty, canEmpty -> c where - makeCanEmptyContainer :: forall f a. Foldable f => f a -> canEmpty a + makeCanEmptyCollection :: forall f a. Foldable f => f a -> canEmpty a -- These are the same function names as the CanEmpty versions, -- but the signatures are different and can't be merged in the @@ -43,7 +43,7 @@ class ( instance onlyNonEmptyList :: OnlyNonEmpty NEL.NonEmptyList L.List where - makeCanEmptyContainer = L.fromFoldable + makeCanEmptyCollection = L.fromFoldable fromFoldable = NEL.fromFoldable head = NEL.head @@ -57,7 +57,7 @@ instance onlyNonEmptyList :: OnlyNonEmpty NEL.NonEmptyList L.List where instance onlyNonEmptyLazyList :: OnlyNonEmpty LNEL.NonEmptyList LL.List where - makeCanEmptyContainer = LL.fromFoldable + makeCanEmptyCollection = LL.fromFoldable fromFoldable = LNEL.fromFoldable head = LNEL.head @@ -79,10 +79,10 @@ testOnlyNonEmpty :: forall c canEmpty. testOnlyNonEmpty _ _ = do let l :: forall f a. Foldable f => f a -> c a - l = makeContainer + l = makeCollection cel :: forall f a. Foldable f => f a -> canEmpty a - cel = makeCanEmptyContainer + cel = makeCanEmptyCollection printTestType "Only nonEmpty" diff --git a/test/Test/OnlyStrict.purs b/test/Test/OnlyStrict.purs index 7373d3f..553db0b 100644 --- a/test/Test/OnlyStrict.purs +++ b/test/Test/OnlyStrict.purs @@ -8,7 +8,7 @@ import Effect (Effect) import Effect.Console (log) import Test.Assert (assert) -import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeContainer) +import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeCollection) import Data.List as L import Data.List.NonEmpty as NEL @@ -57,7 +57,7 @@ testOnlyStrict _ = do let l :: forall f a. Foldable f => f a -> c a - l = makeContainer + l = makeCollection printTestType "Only Strict" diff --git a/test/Test/UpdatedTests.purs b/test/Test/UpdatedTests.purs index ddb2e37..1708854 100644 --- a/test/Test/UpdatedTests.purs +++ b/test/Test/UpdatedTests.purs @@ -7,7 +7,7 @@ import Data.List.Lazy as LL import Data.List.Lazy.NonEmpty as LNEL import Data.List.NonEmpty as NEL import Effect (Effect) -import Test.Common (testCommon, SkipBroken(..), printContainerType) +import Test.Common (testCommon, SkipBroken(..), printCollectionType) import Test.CommonDiffEmptiability (testCommonDiffEmptiability) import Test.NoOverlap (testOnlyLazyCanEmpty, testOnlyLazyNonEmpty, testOnlyStrictCanEmpty, testOnlyStrictNonEmpty) import Test.OnlyCanEmpty (testOnlyCanEmpty) @@ -22,7 +22,6 @@ import Test.OnlyStrict (testOnlyStrict) rebase - fix "an list" -> "a list" - or even "a collection" -- rename makeContainer to makeCollection - upgrade to assertEqual @@ -35,13 +34,23 @@ updatedTests = do testLazyList --testLazyNonEmptyList -- Lots of stuff to fix here - -- testZipList + -- Just using original ZipList tests + {- + Todo + This is a wrapper on Lazy list. Should this be clarified in + the name, and should there be a zip wrapper for non-lazy lists? + Also, it doesn't seem like all instances are tested. Should + testing be expanded? + -} + --testZipList + + -- Just using original ListPartial tests -- testListPartial testBasicList :: Effect Unit testBasicList = do - printContainerType "Basic List" + printCollectionType "Basic List" testCommon nil testCommonDiffEmptiability RunAll nil nil nonEmpty @@ -52,7 +61,7 @@ testBasicList = do testNonEmptyList :: Effect Unit testNonEmptyList = do - printContainerType "NonEmpty List" + printCollectionType "NonEmpty List" testCommon nonEmpty testCommonDiffEmptiability RunAll nonEmpty nil nonEmpty @@ -63,7 +72,7 @@ testNonEmptyList = do testLazyList :: Effect Unit testLazyList = do - printContainerType "Lazy List" + printCollectionType "Lazy List" testCommon lazyNil testCommonDiffEmptiability SkipBrokenLazyCanEmpty lazyNil lazyNil lazyNonEmpty @@ -74,9 +83,9 @@ testLazyList = do testLazyNonEmptyList :: Effect Unit testLazyNonEmptyList = do - printContainerType "Lazy NonEmpty List" + printCollectionType "Lazy NonEmpty List" - -- So much stuff is unsupported for this container that it's not yet + -- So much stuff is unsupported for this collection that it's not yet -- worth using the assertSkip strategy testCommon lazyNonEmpty testCommonDiffEmptiability RunAll lazyNonEmpty lazyNil lazyNonEmpty From 2c530d8eb76236a1cee6f68dbb59921bf287f5e6 Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Tue, 27 Apr 2021 11:13:08 -0700 Subject: [PATCH 09/18] failing attempt with records --- test/Test/CommonDiffEmptiabilityRecord.purs | 211 ++++++++++++++++++++ 1 file changed, 211 insertions(+) create mode 100644 test/Test/CommonDiffEmptiabilityRecord.purs diff --git a/test/Test/CommonDiffEmptiabilityRecord.purs b/test/Test/CommonDiffEmptiabilityRecord.purs new file mode 100644 index 0000000..961daa0 --- /dev/null +++ b/test/Test/CommonDiffEmptiabilityRecord.purs @@ -0,0 +1,211 @@ +module Test.CommonDiffEmptiabilityRecord where + +import Prelude + +import Data.Foldable (class Foldable) +import Data.Function (on) +import Data.List as L +import Data.List.Lazy as LL +import Data.List.Lazy.NonEmpty as LNEL +import Data.List.NonEmpty as NEL +import Data.Maybe (Maybe(..), fromJust) +import Effect (Effect) +import Effect.Console (log) +import Partial.Unsafe (unsafePartial) +import Test.Assert (assert) +import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType) + +--type DeRec :: (Type -> Type) -> (Type -> Type) -> (Type -> Type) -> (Type -> Type) -> (Type -> Type) -> Type +type DeRec c cInverse canEmpty nonEmpty cPattern = + { makeCollection :: forall f a. Foldable f => f a -> c a + + , toCanEmpty :: forall a. c a -> canEmpty a + , toNonEmpty :: forall a. c a -> nonEmpty a + + , catMaybes :: forall a. c (Maybe a) -> canEmpty a + , drop :: forall a. Int -> c a -> canEmpty a + , dropWhile :: forall a. (a -> Boolean) -> c a -> canEmpty a + , filter :: forall a. (a -> Boolean) -> c a -> canEmpty a + , filterM :: forall m a. Monad m => (a -> m Boolean) -> c a -> m (canEmpty a) + , group :: forall a. Eq a => c a -> c (nonEmpty a) + , groupAll :: forall a. Ord a => c a -> c (nonEmpty a) + , groupBy :: forall a. (a -> a -> Boolean) -> c a -> c (nonEmpty a) + , mapMaybe :: forall a b. (a -> Maybe b) -> c a -> canEmpty b + , partition :: forall a. (a -> Boolean) -> c a -> { no :: canEmpty a, yes :: canEmpty a } + , span :: forall a. (a -> Boolean) -> c a -> { init :: canEmpty a, rest :: canEmpty a } + , take :: forall a. Int -> c a -> canEmpty a + , takeEnd :: forall a. Int -> c a -> canEmpty a + , takeWhile :: forall a. (a -> Boolean) -> c a -> canEmpty a + + , cons' :: forall a. a -> cInverse a -> c a + , delete :: forall a. Eq a => a -> c a -> canEmpty a + , deleteBy :: forall a. (a -> a -> Boolean) -> a -> c a -> canEmpty a + , difference :: forall a. Eq a => c a -> c a -> canEmpty a + , dropEnd :: forall a. Int -> c a -> canEmpty a + -- There's a pending PR to update this signature + -- groupAllBy :: forall a. (a -> a -> Ordering) -> c a -> c (nonEmpty a) + , groupAllBy :: forall a. Ord a => (a -> a -> Boolean) -> c a -> c (nonEmpty a) + , pattern :: forall a. c a -> cPattern a + , slice :: Int -> Int -> c ~> canEmpty + , snoc' :: forall a. cInverse a -> a -> c a + , stripPrefix :: forall a. Eq a => cPattern a -> c a -> Maybe (canEmpty a) +} + +testCommonDeRecBasic :: Effect Unit +testCommonDeRecBasic = + testDeRec RunAll L.Nil L.Nil (NEL.singleton 1) + { makeCollection = L.fromFoldable + , toCanEmpty = identity + , toNonEmpty = unsafePartial fromJust <<< NEL.fromList + + , catMaybes = L.catMaybes + , drop = L.drop + , dropWhile = L.dropWhile + , filter = L.filter + , filterM = L.filterM + , group = L.group + , groupAll = L.groupAll + , groupBy = L.groupBy + , mapMaybe = L.mapMaybe + , partition = L.partition + , span = L.span + , take = L.take + , takeEnd = L.takeEnd + , takeWhile = L.takeWhile + + , cons' = L.cons' + , delete = L.delete + , deleteBy = L.deleteBy + , difference = L.difference + , dropEnd = L.dropEnd + , groupAllBy = L.groupAllBy + , pattern = L.Pattern + , slice = L.slice + , snoc' = L.snoc' + , stripPrefix = L.stripPrefix + } + +testDeRec :: forall a c cInverse canEmpty nonEmpty cPattern. + -- Common c => + -- CommonDiffEmptiability c cInverse canEmpty nonEmpty cPattern => + Eq (c (nonEmpty a)) => + Eq (canEmpty a) => + SkipBroken -> c a -> canEmpty a -> nonEmpty a -> + DeRec c cInverse canEmpty nonEmpty cPattern -> + Effect Unit +testDeRec skip _ nil _ + { makeCollection + , toCanEmpty + , toNonEmpty + + , catMaybes + , drop + , dropWhile + , filter + , filterM + , group + , groupAll + , groupBy + , mapMaybe + , partition + , span + , take + , takeEnd + , takeWhile + + , cons' + , delete + , deleteBy + , difference + , dropEnd + , groupAllBy + , pattern + , slice + , snoc' + , stripPrefix + } = do + let + l :: forall f a. Foldable f => f a -> c a + l = makeCollection + + cel :: forall f a. Foldable f => f a -> canEmpty a + cel = toCanEmpty <<< l + + nel :: forall f a. Foldable f => f a -> nonEmpty a + nel = toNonEmpty <<< l + + assertSkip :: Array SkipBroken -> (_ -> Boolean) -> Effect Unit + assertSkip = assertSkipHelper skip + + printTestType "Common (where signatures differ based on emptiability)" + + --catMaybes :: forall a. c (Maybe a) -> c a + -- todo + + log "drop should remove the specified number of items from the front of an list" + assert $ (drop 1 (l [1, 2, 3])) == cel [2, 3] + assert $ (drop (-1) (l [1, 2, 3])) == cel [1, 2, 3] + + log "dropWhile should remove all values that match a predicate from the front of an list" + assert $ (dropWhile (_ /= 1) (l [1, 2, 3])) == cel [1, 2, 3] + assert $ (dropWhile (_ /= 2) (l [1, 2, 3])) == cel [2, 3] + --assert $ (dropWhile (_ /= 1) nil) == nil + + --filter :: forall a. (a -> Boolean) -> c a -> c a + -- todo + + --filterM :: forall m a. Monad m => (a -> m Boolean) -> c a -> m (c a) + -- todo + + log "group should group consecutive equal elements into lists" + assert $ group (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1], nel [2, 2], nel [3, 3, 3], nel [1]] + + log "groupAll should group equal elements into lists" + assertSkip [SkipBrokenLazyCanEmpty] + \_ -> groupAll (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1, 1], nel [2, 2], nel [3, 3, 3]] + --assert $ groupAll (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1, 1], nel [2, 2], nel [3, 3, 3]] + + log "groupBy should group consecutive equal elements into lists based on an equivalence relation" + assert $ groupBy (eq `on` (_ `mod` 10)) (l [1, 2, 12, 3, 13, 23, 11]) == l [nel [1], nel [2, 12], nel [3, 13, 23], nel [11]] + + -- todo - wait for this to be reworked + -- log "groupAllBy should group equal elements into lists based on an comparison function" + --assert $ groupAllBy (compare `on` mod 10) (l [1, 2, 12, 3, 13, 23, 11]) == l [nel [1, 11], nel [2, 12], nel [3, 13, 23]] + + log "mapMaybe should transform every item in an list, throwing out Nothing values" + assert $ mapMaybe (\x -> if x /= 0 then Just x else Nothing) (l [0, 1, 0, 0, 2, 3]) == cel [1, 2, 3] + + log "partition should separate a list into a tuple of lists that do and do not satisfy a predicate" + let partitioned = partition (_ > 2) (l [1, 5, 3, 2, 4]) + assert $ partitioned.yes == cel [5, 3, 4] + assert $ partitioned.no == cel [1, 2] + + log "span should split an list in two based on a predicate" + let spanResult = span (_ < 4) (l [1, 2, 3, 4, 5, 6, 7]) + assert $ spanResult.init == cel [1, 2, 3] + assert $ spanResult.rest == cel [4, 5, 6, 7] + + log "take should keep the specified number of items from the front of an list, discarding the rest" + assert $ (take 1 (l [1, 2, 3])) == cel [1] + assert $ (take 2 (l [1, 2, 3])) == cel [1, 2] + --assert $ (take 1 nil) == nil + assert $ (take 0 (l [1, 2])) == nil + assert $ (take (-1) (l [1, 2])) == nil + + log "takeEnd should keep the specified number of items from the end of an list, discarding the rest" + assertSkip [SkipBrokenLazyCanEmpty] + \_ -> (takeEnd 1 (l [1, 2, 3])) == cel [3] + assertSkip [SkipBrokenLazyCanEmpty] + \_ -> (takeEnd 2 (l [1, 2, 3])) == cel [2, 3] + assertSkip [SkipBrokenLazyCanEmpty] + \_ -> (takeEnd 2 (l [1])) == cel [1] + + --assert $ (takeEnd 1 (l [1, 2, 3])) == cel [3] + --assert $ (takeEnd 2 (l [1, 2, 3])) == cel [2, 3] + ----assert $ (takeEnd 1 nil) == nil + --assert $ (takeEnd 2 (l [1])) == cel [1] + + log "takeWhile should keep all values that match a predicate from the front of an list" + assert $ (takeWhile (_ /= 2) (l [1, 2, 3])) == cel [1] + assert $ (takeWhile (_ /= 3) (l [1, 2, 3])) == cel [1, 2] + --assert $ (takeWhile (_ /= 1) nil) == nil \ No newline at end of file From 0bbca7c7e72749b87fefb0b9f2d66e9cab98bce7 Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Thu, 29 Apr 2021 10:07:14 -0700 Subject: [PATCH 10/18] Mostly working with records --- test/Test/API.purs | 161 ++++ test/Test/{Common.purs => AllTests.purs} | 831 ++++++++++++++------ test/Test/Args/LazyList.purs | 128 +++ test/Test/Args/LazyNonEmptyList.purs | 126 +++ test/Test/Args/List.purs | 121 +++ test/Test/Args/NonEmptyList.purs | 120 +++ test/Test/CommonDiffEmptiability.purs | 299 ------- test/Test/CommonDiffEmptiabilityRecord.purs | 211 ----- test/Test/NoOverlap.purs | 117 --- test/Test/OnlyCanEmpty.purs | 183 ----- test/Test/OnlyLazy.purs | 86 -- test/Test/OnlyNonEmpty.purs | 123 --- test/Test/OnlyStrict.purs | 79 -- test/Test/UpdatedTests.purs | 61 +- 14 files changed, 1274 insertions(+), 1372 deletions(-) create mode 100644 test/Test/API.purs rename test/Test/{Common.purs => AllTests.purs} (52%) create mode 100644 test/Test/Args/LazyList.purs create mode 100644 test/Test/Args/LazyNonEmptyList.purs create mode 100644 test/Test/Args/List.purs create mode 100644 test/Test/Args/NonEmptyList.purs delete mode 100644 test/Test/CommonDiffEmptiability.purs delete mode 100644 test/Test/CommonDiffEmptiabilityRecord.purs delete mode 100644 test/Test/NoOverlap.purs delete mode 100644 test/Test/OnlyCanEmpty.purs delete mode 100644 test/Test/OnlyLazy.purs delete mode 100644 test/Test/OnlyNonEmpty.purs delete mode 100644 test/Test/OnlyStrict.purs diff --git a/test/Test/API.purs b/test/Test/API.purs new file mode 100644 index 0000000..c3441d6 --- /dev/null +++ b/test/Test/API.purs @@ -0,0 +1,161 @@ +module Test.API where + +import Prelude + +import Control.Alternative (class Alternative) +import Control.Lazy (class Lazy) +import Control.Monad.Rec.Class (class MonadRec) +import Data.Foldable (class Foldable) +import Data.Maybe (Maybe) +import Data.Tuple (Tuple) +import Data.Unfoldable (class Unfoldable) + +type Common c = + { makeCollection :: forall f a. Foldable f => f a -> c a + + , concat :: forall a. c (c a) -> c a + , concatMap :: forall a. forall b. (a -> c b) -> c a -> c b + , cons :: forall a. a -> c a -> c a + , elemIndex :: forall a. Eq a => a -> c a -> Maybe Int + , elemLastIndex :: forall a. Eq a => a -> c a -> Maybe Int + , findIndex :: forall a. (a -> Boolean) -> c a -> Maybe Int + , findLastIndex :: forall a. (a -> Boolean) -> c a -> Maybe Int + , foldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> c a -> m b + , index :: forall a. c a -> Int -> Maybe a + , intersect :: forall a. Eq a => c a -> c a -> c a + , intersectBy :: forall a. (a -> a -> Boolean) -> c a -> c a -> c a + , length :: forall a. c a -> Int + , nubEq :: forall a. Eq a => c a -> c a + , nubByEq :: forall a. (a -> a -> Boolean) -> c a -> c a + , range :: Int -> Int -> c Int + , reverse :: c ~> c + , singleton :: forall a. a -> c a + , snoc :: forall a. c a -> a -> c a + , toUnfoldable :: forall f a. Unfoldable f => c a -> f a + , union :: forall a. Eq a => c a -> c a -> c a + , unionBy :: forall a. (a -> a -> Boolean) -> c a -> c a -> c a + , unzip :: forall a b. c (Tuple a b) -> Tuple (c a) (c b) + , zip :: forall a b. c a -> c b -> c (Tuple a b) + , zipWith :: forall a b d. (a -> b -> d) -> c a -> c b -> c d + , zipWithA :: forall a b d m. Applicative m => (a -> b -> m d) -> c a -> c b -> m (c d) + + , appendFoldable :: forall t a. Foldable t => c a -> t a -> c a + , insert :: forall a. Ord a => a -> c a -> c a + , insertBy :: forall a. (a -> a -> Ordering) -> a -> c a -> c a + , nub :: forall a. Ord a => c a -> c a + , nubBy :: forall a. (a -> a -> Ordering) -> c a -> c a + , some :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) + , someRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) + , sort :: forall a. Ord a => c a -> c a + , sortBy :: forall a. (a -> a -> Ordering) -> c a -> c a + , transpose :: forall a. c (c a) -> c (c a) + } + +type CommonDiffEmptiability c cInverse canEmpty nonEmpty cPattern = + { makeCollection :: forall f a. Foldable f => f a -> c a + + , makeCanEmptyCollection :: forall f a. Foldable f => f a -> canEmpty a + , makeNonEmptyCollection :: forall f a. Foldable f => f a -> nonEmpty a + + , catMaybes :: forall a. c (Maybe a) -> canEmpty a + , drop :: forall a. Int -> c a -> canEmpty a + , dropWhile :: forall a. (a -> Boolean) -> c a -> canEmpty a + , filter :: forall a. (a -> Boolean) -> c a -> canEmpty a + , filterM :: forall m a. Monad m => (a -> m Boolean) -> c a -> m (canEmpty a) + , group :: forall a. Eq a => c a -> c (nonEmpty a) + , groupAll :: forall a. Ord a => c a -> c (nonEmpty a) + , groupBy :: forall a. (a -> a -> Boolean) -> c a -> c (nonEmpty a) + , mapMaybe :: forall a b. (a -> Maybe b) -> c a -> canEmpty b + , partition :: forall a. (a -> Boolean) -> c a -> { no :: canEmpty a, yes :: canEmpty a } + , span :: forall a. (a -> Boolean) -> c a -> { init :: canEmpty a, rest :: canEmpty a } + , take :: forall a. Int -> c a -> canEmpty a + , takeEnd :: forall a. Int -> c a -> canEmpty a + , takeWhile :: forall a. (a -> Boolean) -> c a -> canEmpty a + + , cons' :: forall a. a -> cInverse a -> c a + , delete :: forall a. Eq a => a -> c a -> canEmpty a + , deleteBy :: forall a. (a -> a -> Boolean) -> a -> c a -> canEmpty a + , difference :: forall a. Eq a => c a -> c a -> canEmpty a + , dropEnd :: forall a. Int -> c a -> canEmpty a + -- There's a pending PR to update this signature + -- groupAllBy :: forall a. (a -> a -> Ordering) -> c a -> c (nonEmpty a) + , groupAllBy :: forall a. Ord a => (a -> a -> Boolean) -> c a -> c (nonEmpty a) + , pattern :: forall a. c a -> cPattern a + , slice :: Int -> Int -> c ~> canEmpty + , snoc' :: forall a. cInverse a -> a -> c a + , stripPrefix :: forall a. Eq a => cPattern a -> c a -> Maybe (canEmpty a) +} + +type OnlyCanEmpty c nonEmpty = + { makeCollection :: forall f a. Foldable f => f a -> c a + , makeNonEmptyCollection :: forall f a. Foldable f => f a -> nonEmpty a + + -- These are the same function names as the NonEmpty versions, + -- but the signatures are different and can't be merged in the + -- CommonDiffEmptiability tests. This is due to a mismatch in the + -- presence of `Maybe`s. + , fromFoldable :: forall f. Foldable f => f ~> c + , head :: forall a. c a -> Maybe a + , init :: forall a. c a -> Maybe (c a) + , last :: forall a. c a -> Maybe a + , tail :: forall a. c a -> Maybe (c a) + , uncons :: forall a. c a -> Maybe { head :: a, tail :: c a } + + -- These are not available for non-empty collections + , null :: forall a. c a -> Boolean + , many :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) + , manyRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) + } + +type OnlyNonEmpty c canEmpty = + { makeCollection :: forall f a. Foldable f => f a -> c a + , makeCanEmptyCollection :: forall f a. Foldable f => f a -> canEmpty a + + -- These are the same function names as the CanEmpty versions, + -- but the signatures are different and can't be merged in the + -- CommonDiffEmptiability tests. This is due to a mismatch in the + -- presence of `Maybe`s. + + , fromFoldable :: forall f a. Foldable f => f a -> Maybe (c a) + , head :: forall a. c a -> a + , init :: forall a. c a -> canEmpty a + , last :: forall a. c a -> a + , tail :: forall a. c a -> canEmpty a + , uncons :: forall a. c a -> { head :: a, tail :: canEmpty a } + + -- These are only available for NonEmpty collections + + , fromList :: forall a. canEmpty a -> Maybe (c a) + , toList :: c ~> canEmpty + } + +type OnlyStrict c = + { makeCollection :: forall f a. Foldable f => f a -> c a + + -- Same names, but different APIs (with Maybe) + , alterAt :: forall a. Int -> (a -> Maybe a) -> c a -> Maybe (c a) + , insertAt :: forall a. Int -> a -> c a -> Maybe (c a) + , modifyAt :: forall a. Int -> (a -> a) -> c a -> Maybe (c a) + , updateAt :: forall a. Int -> a -> c a -> Maybe (c a) + } + +type OnlyLazy c = + { makeCollection :: forall f a. Foldable f => f a -> c a + + -- Same names, but different APIs (without Maybe) + , alterAt :: forall a. Int -> (a -> Maybe a) -> c a -> c a + , insertAt :: forall a. Int -> a -> c a -> c a + , modifyAt :: forall a. Int -> (a -> a) -> c a -> c a + , updateAt :: forall a. Int -> a -> c a -> c a + + -- These are only available for Lazy collections + , iterate :: forall a. (a -> a) -> a -> c a + , repeat :: forall a. a -> c a + , cycle :: forall a. c a -> c a + , foldrLazy :: forall a b. Lazy b => (a -> b -> b) -> b -> c a -> b + , scanlLazy :: forall a b. (b -> a -> b) -> b -> c a -> c b + } + + +-- Todo - no overlap +-- Or may not be necessary to define here diff --git a/test/Test/Common.purs b/test/Test/AllTests.purs similarity index 52% rename from test/Test/Common.purs rename to test/Test/AllTests.purs index d12bcf8..ff68d55 100644 --- a/test/Test/Common.purs +++ b/test/Test/AllTests.purs @@ -1,12 +1,15 @@ -module Test.Common where +module Test.AllTests where import Prelude import Control.Alt (class Alt, (<|>)) -import Control.Alternative (class Alternative) +import Control.Alternative (class Alternative, class Plus, empty) +import Control.Comonad (class Comonad) import Control.Extend (class Extend, (<<=)) import Control.Lazy (class Lazy) import Control.Monad.Rec.Class (class MonadRec) +import Control.MonadPlus (class MonadPlus) +import Control.MonadZero (class MonadZero) import Data.Array as Array import Data.Eq (class Eq1, eq1) import Data.Foldable (class Foldable, foldMap, foldl, sum) @@ -18,17 +21,18 @@ import Data.List as L import Data.List.Lazy as LL import Data.List.Lazy.NonEmpty as LNEL import Data.List.NonEmpty as NEL -import Data.Maybe (Maybe(..), fromJust) +import Data.Maybe (Maybe(..), fromJust, isNothing) import Data.Monoid.Additive (Additive(..)) import Data.Ord (class Ord1) import Data.Traversable (class Traversable, traverse) import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) import Data.Tuple (Tuple(..)) -import Data.Unfoldable (class Unfoldable) +import Data.Unfoldable (class Unfoldable, unfoldr) import Data.Unfoldable1 (class Unfoldable1, unfoldr1) import Effect (Effect) import Effect.Console (log) import Partial.Unsafe (unsafePartial) +import Test.API (Common, CommonDiffEmptiability, OnlyCanEmpty, OnlyLazy, OnlyNonEmpty, OnlyStrict) import Test.Assert (assert, assertEqual, assertEqual') {- @@ -65,245 +69,80 @@ printTestType :: String -> Effect Unit printTestType str = do log $ "---- " <> str <> " Tests ----" -class ( - Alt c - , Applicative c - , Apply c - , Bind c - , Eq (c Int) - , Eq1 c - , Extend c - , Foldable c - , FoldableWithIndex Int c - , Functor c - , FunctorWithIndex Int c - , Monad c - , Ord (c Int) - , Ord1 c - , Semigroup (c Int) - , Show (c Int) - , Traversable c - , TraversableWithIndex Int c - , Unfoldable1 c -) <= Common c where - makeCollection :: forall f a. Foldable f => f a -> c a - - concat :: forall a. c (c a) -> c a - concatMap :: forall a. forall b. (a -> c b) -> c a -> c b - cons :: forall a. a -> c a -> c a - elemIndex :: forall a. Eq a => a -> c a -> Maybe Int - elemLastIndex :: forall a. Eq a => a -> c a -> Maybe Int - findIndex :: forall a. (a -> Boolean) -> c a -> Maybe Int - findLastIndex :: forall a. (a -> Boolean) -> c a -> Maybe Int - foldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> c a -> m b - index :: forall a. c a -> Int -> Maybe a - intersect :: forall a. Eq a => c a -> c a -> c a - intersectBy :: forall a. (a -> a -> Boolean) -> c a -> c a -> c a - length :: forall a. c a -> Int - nubEq :: forall a. Eq a => c a -> c a - nubByEq :: forall a. (a -> a -> Boolean) -> c a -> c a - range :: Int -> Int -> c Int - reverse :: c ~> c - singleton :: forall a. a -> c a - snoc :: forall a. c a -> a -> c a - toUnfoldable :: forall f a. Unfoldable f => c a -> f a - union :: forall a. Eq a => c a -> c a -> c a - unionBy :: forall a. (a -> a -> Boolean) -> c a -> c a -> c a - unzip :: forall a b. c (Tuple a b) -> Tuple (c a) (c b) - zip :: forall a b. c a -> c b -> c (Tuple a b) - zipWith :: forall a b d. (a -> b -> d) -> c a -> c b -> c d - zipWithA :: forall a b d m. Applicative m => (a -> b -> m d) -> c a -> c b -> m (c d) - - appendFoldable :: forall t a. Foldable t => c a -> t a -> c a - insert :: forall a. Ord a => a -> c a -> c a - insertBy :: forall a. (a -> a -> Ordering) -> a -> c a -> c a - nub :: forall a. Ord a => c a -> c a - nubBy :: forall a. (a -> a -> Ordering) -> c a -> c a - some :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) - someRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) - sort :: forall a. Ord a => c a -> c a - sortBy :: forall a. (a -> a -> Ordering) -> c a -> c a - transpose :: forall a. c (c a) -> c (c a) - - - --- Don't know how to define this in Test.Data.List --- Wrapping is tricky. -instance commonList :: Common L.List where - makeCollection = L.fromFoldable - - concat = L.concat - concatMap = L.concatMap - cons = L.Cons -- Should basic list have a cons function wrapping the Cons constructor? - elemIndex = L.elemIndex - elemLastIndex = L.elemLastIndex - findIndex = L.findIndex - findLastIndex = L.findLastIndex - foldM = L.foldM - index = L.index - intersect = L.intersect - intersectBy = L.intersectBy - length = L.length - nubEq = L.nubEq - nubByEq = L.nubByEq - range = L.range - reverse = L.reverse - singleton = L.singleton - snoc = L.snoc - toUnfoldable = L.toUnfoldable - union = L.union - unionBy = L.unionBy - unzip = L.unzip - zip = L.zip - zipWith = L.zipWith - zipWithA = L.zipWithA - - appendFoldable = L.appendFoldable - insert = L.insert - insertBy = L.insertBy - nub = L.nub - nubBy = L.nubBy - some = L.some - someRec = L.someRec - sort = L.sort - sortBy = L.sortBy - transpose = L.transpose - -instance commonNonEmptyList :: Common NEL.NonEmptyList where - makeCollection = unsafePartial fromJust <<< NEL.fromFoldable - - concat = NEL.concat - concatMap = NEL.concatMap - cons = NEL.cons - elemIndex = NEL.elemIndex - elemLastIndex = NEL.elemLastIndex - findIndex = NEL.findIndex - findLastIndex = NEL.findLastIndex - foldM = NEL.foldM - index = NEL.index - intersect = NEL.intersect - intersectBy = NEL.intersectBy - length = NEL.length - nubEq = NEL.nubEq - nubByEq = NEL.nubByEq - range = NEL.range - reverse = NEL.reverse - singleton = NEL.singleton - snoc = NEL.snoc - toUnfoldable = NEL.toUnfoldable - union = NEL.union - unionBy = NEL.unionBy - unzip = NEL.unzip - zip = NEL.zip - zipWith = NEL.zipWith - zipWithA = NEL.zipWithA - - appendFoldable = NEL.appendFoldable - insert = NEL.insert - insertBy = NEL.insertBy - nub = NEL.nub - nubBy = NEL.nubBy - some = NEL.some - someRec = NEL.someRec - sort = NEL.sort - sortBy = NEL.sortBy - transpose = NEL.transpose - -instance commonLazyList :: Common LL.List where - makeCollection = LL.fromFoldable - - concat = LL.concat - concatMap = LL.concatMap - cons = LL.cons - elemIndex = LL.elemIndex - elemLastIndex = LL.elemLastIndex - findIndex = LL.findIndex - findLastIndex = LL.findLastIndex - foldM = LL.foldM - index = LL.index - intersect = LL.intersect - intersectBy = LL.intersectBy - length = LL.length - nubEq = LL.nubEq - nubByEq = LL.nubByEq - range = LL.range - reverse = LL.reverse - singleton = LL.singleton - snoc = LL.snoc - toUnfoldable = LL.toUnfoldable - union = LL.union - unionBy = LL.unionBy - unzip = LL.unzip - zip = LL.zip - zipWith = LL.zipWith - zipWithA = LL.zipWithA - - appendFoldable = LL.appendFoldable - insert = LL.insert - insertBy = LL.insertBy - nub = LL.nub - nubBy = LL.nubBy - some = LL.some - someRec = LL.someRec - sort = LL.sort - sortBy = LL.sortBy - transpose = LL.transpose - -instance commonLazyNonEmptyList :: Common LNEL.NonEmptyList where - makeCollection = unsafePartial fromJust <<< LNEL.fromFoldable - - concat = LNEL.concat - concatMap = LNEL.concatMap - cons = LNEL.cons - elemIndex = LNEL.elemIndex - elemLastIndex = LNEL.elemLastIndex - findIndex = LNEL.findIndex - findLastIndex = LNEL.findLastIndex - foldM = LNEL.foldM - index = LNEL.index - intersect = LNEL.intersect - intersectBy = LNEL.intersectBy - length = LNEL.length - nubEq = LNEL.nubEq - nubByEq = LNEL.nubByEq - range = LNEL.range - reverse = LNEL.reverse - singleton = LNEL.singleton - snoc = LNEL.snoc - toUnfoldable = LNEL.toUnfoldable - union = LNEL.union - unionBy = LNEL.unionBy - unzip = LNEL.unzip - zip = LNEL.zip - zipWith = LNEL.zipWith - zipWithA = LNEL.zipWithA - - appendFoldable = LNEL.appendFoldable - insert = LNEL.insert - insertBy = LNEL.insertBy - nub = LNEL.nub - nubBy = LNEL.nubBy - some = LNEL.some - someRec = LNEL.someRec - sort = LNEL.sort - sortBy = LNEL.sortBy - transpose = LNEL.transpose - testCommon :: forall c. - Common c => + Alt c => + Applicative c => + Apply c => + Bind c => + Eq (c Int) => + Eq1 c => + Extend c => + Foldable c => + FoldableWithIndex Int c => + Functor c => + FunctorWithIndex Int c => + Monad c => + Ord (c Int) => + Ord1 c => + Semigroup (c Int) => + Show (c Int) => + Traversable c => + TraversableWithIndex Int c => + Unfoldable1 c => + -- Eq (c String) => Eq (c (Tuple Int String)) => Eq (c (c String)) => + Eq (c (c Int)) => -- temp Eq (c (Array Int)) => Show (c String) => Show (c (Tuple Int String)) => Show (c (c String)) => + Show (c (c Int)) => -- temp Show (c (Array Int)) => - c Int -> Effect Unit --- Would likely be better to pass a proxy type -testCommon _ = do + Common c -> Effect Unit +testCommon + r@{ makeCollection + + , concat + , concatMap + , cons + , elemIndex + , elemLastIndex + , findIndex + , findLastIndex + , foldM + , index + , intersect + , intersectBy + , length + , nubEq + , nubByEq + , range + , reverse + , singleton + , snoc + , toUnfoldable + , union + , unionBy + , unzip + , zip + , zipWith + , zipWithA + + , appendFoldable + , insert + , insertBy + , nub + , nubBy + , some + , someRec + , sort + , sortBy + , transpose + } = do let - l :: forall f a. Foldable f => f a -> c a + -- l :: forall f a. Foldable f => f a -> c a l = makeCollection rg :: Int -> Int -> c Int @@ -486,15 +325,19 @@ testCommon _ = do -- log "catMaybe should take a collection of Maybe values and throw out Nothings" -- assertEqual { actual: catMaybes (l [Nothing, Just 2, Nothing, Just 4]), expected: l [2, 4] } + + assertEqual { actual: l [l [1, 2], l [3, 4]], expected: l [l [1, 2], l [3, 4]] } + log "concat should join a collection of collections" - assertEqual { actual: concat $ l [l [1, 2], l [3, 4]], expected: l [1, 2, 3, 4] } + assertEqual { actual: r.concat $ l [l [1, 2], l [3, 4]], expected: l [1, 2, 3, 4] } + assertEqual { actual: r.concat $ l [l [1, 2], l [3, 4]], expected: l [1, 2, 3, 4] } let doubleAndOrig :: Int -> c Int doubleAndOrig x = cons (x * 2) $ singleton x log "concatMap should be equivalent to (concat <<< map)" - assertEqual { actual: concatMap doubleAndOrig $ l [1, 2, 3], expected: concat $ map doubleAndOrig $ l [1, 2, 3] } + assertEqual { actual: concatMap doubleAndOrig $ l [1, 2, 3], expected: r.concat $ map doubleAndOrig $ l [1, 2, 3] } log "cons should add an element to the front of the collection" assertEqual { actual: cons 1 $ l [2, 3], expected: l [1,2,3] } @@ -552,8 +395,8 @@ testCommon _ = do assertEqual { actual: intersectBy (\x y -> x * 2 == y) (l [1, 2, 3]) $ l [2, 6], expected: l [1, 3] } log "length should return the number of items in a collection" - assertEqual { actual: length $ l [1], expected: 1 } - assertEqual { actual: length $ l [1, 2, 3, 4, 5], expected: 5 } + assertEqual { actual: r.length $ l [1], expected: 1 } + assertEqual { actual: r.length $ l [1, 2, 3, 4, 5], expected: 5 } log "length should be stack-safe" void $ pure $ length bigCollection @@ -567,7 +410,13 @@ testCommon _ = do -- assertEqual { actual: modifyAt 7 (_ + 1) $ l [1,2,3], expected: Nothing } log "nubEq should remove duplicate elements from the collection, keeping the first occurence" - assertEqual { actual: nubEq $ l [1, 2, 2, 3, 4, 1], expected: l [1, 2, 3, 4] } + -- let + -- thing :: c Int + -- thing = l [1, 2, 2, 3, 4, 1] + -- res = r.nubEq $ thing + --assertEqual { actual: r.nubEq $ thing, expected: l [1, 2, 3, 4] } + -- Todo - very confused why this won't work + --assertEqual { actual: nubEq $ l [1, 2, 2, 3, 4, 1], expected: l [1, 2, 3, 4] } log "nubByEq should remove duplicate items from the collection using a supplied predicate" let mod3eq = eq `on` \n -> mod n 3 @@ -579,7 +428,7 @@ testCommon _ = do assertEqual { actual: range 2 (-3), expected: l [2, 1, 0, -1, -2, -3] } log "reverse should reverse the order of items in a collection" - assertEqual { actual: reverse $ l [1, 2, 3], expected: l [3, 2, 1] } + assertEqual { actual: r.reverse $ l [1, 2, 3], expected: l [3, 2, 1] } log "singleton should construct a collection with a single value" assertEqual { actual: singleton 5, expected: l [5] } @@ -597,7 +446,7 @@ testCommon _ = do assertEqual { actual: unionBy (\_ y -> y < 5) (l [1, 2, 3]) $ l [2, 3, 4, 5, 6], expected: l [1, 2, 3, 5, 6] } log "unzip should deconstruct a collection of tuples into a tuple of collections" - assertEqual { actual: unzip $ l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"], expected: Tuple (l [1, 2, 3]) $ l ["a", "b", "c"] } + assertEqual { actual: r.unzip $ l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"], expected: Tuple (l [1, 2, 3]) $ l ["a", "b", "c"] } log "zip should use the specified function to zip two collections together" assertEqual { actual: zip (l [1, 2, 3]) $ l ["a", "b", "c"], expected: l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"] } @@ -660,8 +509,6 @@ testCommon _ = do -} - - -- replicateM :: forall m a. Monad m => Int -> m a -> m (c a) -- some :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) -- someRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) @@ -669,3 +516,503 @@ testCommon _ = do -- sortBy :: forall a. (a -> a -> Ordering) -> c a -> c a -- transpose :: forall a. c (c a) -> c (c a) + + + +testCommonDiffEmptiability :: forall c cInverse canEmpty nonEmpty cPattern. + Eq (c (nonEmpty Int)) => + Eq (canEmpty Int) => + Eq (c (c Int)) => + SkipBroken -> + CommonDiffEmptiability c cInverse canEmpty nonEmpty cPattern -> + Effect Unit +testCommonDiffEmptiability skip + { makeCollection + , makeCanEmptyCollection + , makeNonEmptyCollection + + , catMaybes + , drop + , dropWhile + , filter + , filterM + , group + , groupAll + , groupBy + , mapMaybe + , partition + , span + , take + , takeEnd + , takeWhile + + , cons' + , delete + , deleteBy + , difference + , dropEnd + , groupAllBy + , pattern + , slice + , snoc' + , stripPrefix + } = do + let + -- l :: forall f a. Foldable f => f a -> c a + l = makeCollection + + -- cel :: forall f a. Foldable f => f a -> canEmpty a + -- cel = toCanEmpty <<< l + -- cel x = toCanEmpty (makeCollection x) + cel = makeCanEmptyCollection + + -- nel :: forall f a. Foldable f => f a -> nonEmpty a + -- nel x = toNonEmpty (makeCollection x) + nel = makeNonEmptyCollection + + assertSkip :: Array SkipBroken -> (_ -> Boolean) -> Effect Unit + assertSkip = assertSkipHelper skip + + printTestType "Common (where signatures differ based on emptiability)" + + --catMaybes :: forall a. c (Maybe a) -> c a + -- todo + + + -- temporary for troubleshooting + assert $ l [l [1, 2], l [3, 4]] == l [l [1, 2], l [3, 4]] + + log "drop should remove the specified number of items from the front of an list" + assert $ (drop 1 (l [1, 2, 3])) == cel [2, 3] + assert $ (drop (-1) (l [1, 2, 3])) == cel [1, 2, 3] + + log "dropWhile should remove all values that match a predicate from the front of an list" + assert $ (dropWhile (_ /= 1) (l [1, 2, 3])) == cel [1, 2, 3] + assert $ (dropWhile (_ /= 2) (l [1, 2, 3])) == cel [2, 3] + --assert $ (dropWhile (_ /= 1) nil) == nil + + --filter :: forall a. (a -> Boolean) -> c a -> c a + -- todo + + --filterM :: forall m a. Monad m => (a -> m Boolean) -> c a -> m (c a) + -- todo + + log "group should group consecutive equal elements into lists" + assert $ group (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1], nel [2, 2], nel [3, 3, 3], nel [1]] + + log "groupAll should group equal elements into lists" + assertSkip [SkipBrokenLazyCanEmpty] + \_ -> groupAll (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1, 1], nel [2, 2], nel [3, 3, 3]] + --assert $ groupAll (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1, 1], nel [2, 2], nel [3, 3, 3]] + + log "groupBy should group consecutive equal elements into lists based on an equivalence relation" + assert $ groupBy (eq `on` (_ `mod` 10)) (l [1, 2, 12, 3, 13, 23, 11]) == l [nel [1], nel [2, 12], nel [3, 13, 23], nel [11]] + + -- todo - wait for this to be reworked + -- log "groupAllBy should group equal elements into lists based on an comparison function" + --assert $ groupAllBy (compare `on` mod 10) (l [1, 2, 12, 3, 13, 23, 11]) == l [nel [1, 11], nel [2, 12], nel [3, 13, 23]] + + log "mapMaybe should transform every item in an list, throwing out Nothing values" + assert $ mapMaybe (\x -> if x /= 0 then Just x else Nothing) (l [0, 1, 0, 0, 2, 3]) == cel [1, 2, 3] + + log "partition should separate a list into a tuple of lists that do and do not satisfy a predicate" + let partitioned = partition (_ > 2) (l [1, 5, 3, 2, 4]) + assert $ partitioned.yes == cel [5, 3, 4] + assert $ partitioned.no == cel [1, 2] + + log "span should split an list in two based on a predicate" + let spanResult = span (_ < 4) (l [1, 2, 3, 4, 5, 6, 7]) + assert $ spanResult.init == cel [1, 2, 3] + assert $ spanResult.rest == cel [4, 5, 6, 7] + + log "take should keep the specified number of items from the front of an list, discarding the rest" + assert $ (take 1 (l [1, 2, 3])) == cel [1] + assert $ (take 2 (l [1, 2, 3])) == cel [1, 2] + --assert $ (take 1 nil) == nil + assert $ (take 0 (l [1, 2])) == cel [] + assert $ (take (-1) (l [1, 2])) == cel [] + + log "takeEnd should keep the specified number of items from the end of an list, discarding the rest" + assertSkip [SkipBrokenLazyCanEmpty] + \_ -> (takeEnd 1 (l [1, 2, 3])) == cel [3] + assertSkip [SkipBrokenLazyCanEmpty] + \_ -> (takeEnd 2 (l [1, 2, 3])) == cel [2, 3] + assertSkip [SkipBrokenLazyCanEmpty] + \_ -> (takeEnd 2 (l [1])) == cel [1] + + --assert $ (takeEnd 1 (l [1, 2, 3])) == cel [3] + --assert $ (takeEnd 2 (l [1, 2, 3])) == cel [2, 3] + ----assert $ (takeEnd 1 nil) == nil + --assert $ (takeEnd 2 (l [1])) == cel [1] + + log "takeWhile should keep all values that match a predicate from the front of an list" + assert $ (takeWhile (_ /= 2) (l [1, 2, 3])) == cel [1] + assert $ (takeWhile (_ /= 3) (l [1, 2, 3])) == cel [1, 2] + --assert $ (takeWhile (_ /= 1) nil) == nil + + + + +testOnlyCanEmpty :: forall c nonEmpty. + Alternative c => + MonadPlus c => + MonadZero c => + Monoid (c Int) => + Plus c => + Unfoldable c => + -- + Eq (c Int) => + Eq (c (nonEmpty Int)) => + OnlyCanEmpty c nonEmpty -> Effect Unit +testOnlyCanEmpty + { makeCollection + , makeNonEmptyCollection + + , fromFoldable + , head + , init + , last + , tail + , uncons + + , null + , many + , manyRec + } = do + let + l = makeCollection + nel = makeNonEmptyCollection + + nil :: c Int + nil = l [] + + printTestType "Only canEmpty" + + -- ======= Typeclass tests ======== + + -- Alternative + -- applicative and plus + -- (f <|> g) <*> x == (f <*> x) <|> (g <*> x) + -- empty <*> f == empty + + -- MonadPlus + -- Additional law on MonadZero + -- (x <|> y) >>= f == (x >>= f) <|> (y >>= f) + + -- MonadZero + -- monad and alternative + -- empty >>= f = empty + + -- Monoid + -- mempty :: c + log "mempty should not change the collection it is appended to" + assert $ l [5] <> mempty == l [5] + log "mempty should be an empty collection" + assert $ l [] == (mempty :: c Int) + + -- Plus + -- empty :: forall a. c a + log "empty should create an empty collection" + assert $ l [] == (empty :: c Int) + + -- Unfoldable + -- unfoldr :: forall a b. (b -> Maybe (Tuple a b)) -> b -> c a + + log "unfoldr should maintain order" + let + step :: Int -> Maybe (Tuple Int Int) + step 6 = Nothing + step n = Just (Tuple n (n + 1)) + assert $ l [1, 2, 3, 4, 5] == unfoldr step 1 + + + -- ======= Functions tests ======== + + --fromFoldable :: forall f. Foldable f => f ~> c + --already extensively checked in common tests + + -- These are the remaining functions that can't be deduplicated due to use of Maybe + + -- Todo - double-check the phrasing on these? Might be confusing to refer to a + -- non-empty canEmpty list. + + log "head should return a Just-NEL.NonEmptyListped first value of a non-empty list" + assert $ head (l [1, 2]) == Just 1 + + log "head should return Nothing for an empty list" + assert $ head nil == Nothing + + -- Todo - phrasing should be changed to note all but last (not all but first). + log "init should return a Just-NEL.NonEmptyListped list containing all the items in an list apart from the first for a non-empty list" + assert $ init (l [1, 2, 3]) == Just (l [1, 2]) + + log "init should return Nothing for an empty list" + assert $ init nil == Nothing + + + log "last should return a Just-NEL.NonEmptyListped last value of a non-empty list" + assert $ last (l [1, 2]) == Just 2 + + log "last should return Nothing for an empty list" + assert $ last nil == Nothing + + + log "tail should return a Just-NEL.NonEmptyListped list containing all the items in an list apart from the first for a non-empty list" + assert $ tail (l [1, 2, 3]) == Just (l [2, 3]) + + log "tail should return Nothing for an empty list" + assert $ tail nil == Nothing + + + log "uncons should return nothing when used on an empty list" + assert $ isNothing (uncons nil) + + log "uncons should split an list into a head and tail record when there is at least one item" + assert $ uncons (l [1]) == Just {head: 1, tail: l []} + assert $ uncons (l [1, 2, 3]) == Just {head: 1, tail: l [2, 3]} + + + + + +testOnlyNonEmpty :: forall c canEmpty. + Comonad c => + --, Foldable1 c => -- missing from LazyNonEmptyList + --, Traversable1 c => -- missing from LazyNonEmptyList + Eq (c Int) => + Eq (canEmpty Int) => + Show (c Int) => + Show (canEmpty Int) => + OnlyNonEmpty c canEmpty -> Effect Unit +testOnlyNonEmpty + r@{ makeCollection + , makeCanEmptyCollection + + , fromFoldable + , head + , init + , last + , tail + , uncons + + , fromList + , toList + } = do + let + l = makeCollection + + cel = makeCanEmptyCollection + + printTestType "Only nonEmpty" + + -- ======= Typeclass tests ======== + + -- Todo + + -- Comonad + -- Foldable1 + -- Traversable1 + + -- ======= Functions tests ======== + + log "fromList should convert from a List to a NonEmptyList" + assertEqual { actual: r.fromList $ cel [1, 2, 3], expected: Just $ l [1, 2, 3] } + assertEqual { actual: r.fromList $ cel ([] :: _ Int), expected: Nothing } + + log "toList should convert from a NonEmptyList to a List" + assertEqual { actual: r.toList $ l [1, 2, 3], expected: cel [1, 2, 3] } + + + -- These are the remaining functions that can't be deduplicated due to use of Maybe + + log "head should return a the first value" + assert $ head (l [1, 2]) == 1 + + log "init should return a canEmpty collection of all but the last value" + assert $ init (l [1, 2, 3]) == cel [1, 2] + + log "last should return the last value" + assert $ last (l [1, 2]) == 2 + + log "tail should return a canEmpty collection of all but the first value" + assert $ tail (l [1, 2, 3]) == cel [2, 3] + + log "uncons should split a collection into a record containing the first and remaining values" + assert $ uncons (l [1]) == {head: 1, tail: cel []} + assert $ uncons (l [1, 2, 3]) == {head: 1, tail: cel [2, 3]} + + + + + +testOnlyLazy :: forall c. + -- Lazy (c Int) => -- missing from LazyNonEmptyList + -- + Eq (c Int) => + OnlyLazy c -> Effect Unit +testOnlyLazy + { makeCollection + + , alterAt + , insertAt + , modifyAt + , updateAt + + , iterate + , repeat + , cycle + , foldrLazy + , scanlLazy + } = do + let + l = makeCollection + + printTestType "Only Lazy" + + log "insertAt should add an item at the specified index" + assert $ (insertAt 0 1 (l [2, 3])) == (l [1, 2, 3]) + assert $ (insertAt 1 1 (l [2, 3])) == (l [2, 1, 3]) + assert $ (insertAt 2 1 (l [2, 3])) == (l [2, 3, 1]) + + log "modifyAt should update an item at the specified index" + assert $ (modifyAt 0 (_ + 1) (l [1, 2, 3])) == (l [2, 2, 3]) + assert $ (modifyAt 1 (_ + 1) (l [1, 2, 3])) == (l [1, 3, 3]) + + log "updateAt should replace an item at the specified index" + assert $ (updateAt 0 9 (l [1, 2, 3])) == (l [9, 2, 3]) + assert $ (updateAt 1 9 (l [1, 2, 3])) == (l [1, 9, 3]) + + +testOnlyStrict :: forall c. + Eq (c Int) => + OnlyStrict c -> Effect Unit +testOnlyStrict + { makeCollection + + , alterAt + , insertAt + , modifyAt + , updateAt + } = do + + let + l = makeCollection + + printTestType "Only Strict" + + -- todo insertAt test + -- missing from original test suite + + -- todo modifyAt test + -- missing from original test suite + + log "updateAt should replace an item at the specified index" + assert $ (updateAt 0 9 (l [1, 2, 3])) == Just (l [9, 2, 3]) + assert $ (updateAt 1 9 (l [1, 2, 3])) == Just (l [1, 9, 3]) + + log "updateAt should return Nothing if the index is out of range" + assert $ (updateAt 5 9 (l [1, 2, 3])) == Nothing + + + +-- Functions that cannot be tested generically. + +-- Debating whether these should be passed a record defined in the API? + + +assertSkipAlways :: (_ -> Boolean) -> Effect Unit +assertSkipAlways _ = + log "...skipped" + +testOnlyStrictCanEmpty :: Effect Unit +testOnlyStrictCanEmpty = do + + let + l :: forall f a. Foldable f => f a -> L.List a + l = L.fromFoldable + + printTestType "Only Strict canEmpty" + + -- Common function names, but different signatures + + log "deleteAt should remove an item at the specified index" + assert $ L.deleteAt 0 (l [1, 2, 3]) == Just (l [2, 3]) + assert $ L.deleteAt 1 (l [1, 2, 3]) == Just (l [1, 3]) + + -- Corner Cases + + -- Unique functions + + +testOnlyStrictNonEmpty :: Effect Unit +testOnlyStrictNonEmpty = do + + let + l :: forall f a. Foldable f => f a -> NEL.NonEmptyList a + l = unsafePartial fromJust <<< NEL.fromFoldable + + cel :: forall f a. Foldable f => f a -> L.List a + cel = L.fromFoldable + + printTestType "Only Strict NonEmpty" + + -- Common function names, but different signatures + + log "deleteAt should remove an item at the specified index" + assertSkipAlways \_ -> NEL.deleteAt 0 (l [1, 2, 3]) == Just (cel [2, 3]) + assertSkipAlways \_ -> NEL.deleteAt 1 (l [1, 2, 3]) == Just (cel [1, 3]) + + -- Corner Cases + + -- Unique functions + + +testOnlyLazyCanEmpty :: Effect Unit +testOnlyLazyCanEmpty = do + + let + l :: forall f a. Foldable f => f a -> LL.List a + l = LL.fromFoldable + + printTestType "Only Lazy canEmpty" + + -- Common function names, but different signatures + + log "deleteAt should remove an item at the specified index" + assert $ LL.deleteAt 0 (l [1, 2, 3]) == l [2, 3] + assert $ LL.deleteAt 1 (l [1, 2, 3]) == l [1, 3] + + -- Corner Cases + + -- Unique functions + + -- replicate (specialized from Unfoldable's replicate) + -- replicateM (specialized from Unfoldable's replicateA) + + +testOnlyLazyNonEmpty :: Effect Unit +testOnlyLazyNonEmpty = do + + let + l :: forall f a. Foldable f => f a -> LNEL.NonEmptyList a + l = unsafePartial fromJust <<< LNEL.fromFoldable + + cel :: forall f a. Foldable f => f a -> LL.List a + cel = LL.fromFoldable + + printTestType "Only Lazy NonEmpty" + + -- Common function names, but different signatures + + log "deleteAt should remove an item at the specified index" + assert $ LNEL.deleteAt 0 (l [1, 2, 3]) == cel [2, 3] + assert $ LNEL.deleteAt 1 (l [1, 2, 3]) == cel [1, 3] + + -- Corner Cases + + -- Unique functions + + -- replicate1 (specialized from Unfoldable1's replicate1) + -- replicate1M (specialized from Unfoldable1's replicate1A) + + diff --git a/test/Test/Args/LazyList.purs b/test/Test/Args/LazyList.purs new file mode 100644 index 0000000..7187e4e --- /dev/null +++ b/test/Test/Args/LazyList.purs @@ -0,0 +1,128 @@ +module Test.Args.LazyList where + +import Data.List.Lazy + +import Data.Foldable (class Foldable) +import Data.List.Lazy.NonEmpty as NEL +import Data.Maybe (fromJust) +import Partial.Unsafe (unsafePartial) +import Prelude ((<<<)) +import Test.API (Common, CommonDiffEmptiability, OnlyCanEmpty, OnlyLazy) + +makeCollection :: forall a f. Foldable f => f a -> List a +makeCollection = fromFoldable + +makeCanEmptyCollection :: forall a f. Foldable f => f a -> List a +makeCanEmptyCollection = fromFoldable + +makeNonEmptyCollection :: forall a f. Foldable f => f a -> NEL.NonEmptyList a +makeNonEmptyCollection = unsafePartial fromJust <<< NEL.fromFoldable + + +common :: Common List +common = + { makeCollection + + , concat + , concatMap + , cons + , elemIndex + , elemLastIndex + , findIndex + , findLastIndex + , foldM + , index + , intersect + , intersectBy + , length + , nubEq + , nubByEq + , range + , reverse + , singleton + , snoc + , toUnfoldable + , union + , unionBy + , unzip + , zip + , zipWith + , zipWithA + + , appendFoldable + , insert + , insertBy + , nub + , nubBy + , some + , someRec + , sort + , sortBy + , transpose + } + +commonDiffEmptiability :: CommonDiffEmptiability List NEL.NonEmptyList List NEL.NonEmptyList Pattern +commonDiffEmptiability = + { makeCollection + , makeCanEmptyCollection + , makeNonEmptyCollection + + , catMaybes + , drop + , dropWhile + , filter + , filterM + , group + , groupAll + , groupBy + , mapMaybe + , partition + , span + , take + , takeEnd + , takeWhile + + , cons' + , delete + , deleteBy + , difference + , dropEnd + , groupAllBy + , pattern: Pattern + , slice + , snoc' + , stripPrefix + } + +onlyCanEmpty :: OnlyCanEmpty List NEL.NonEmptyList +onlyCanEmpty = + { makeCollection + , makeNonEmptyCollection + + , fromFoldable + , head + , init + , last + , tail + , uncons + + , null + , many + , manyRec + } + +onlyLazy :: OnlyLazy List +onlyLazy = + { makeCollection + + , alterAt + , insertAt + , modifyAt + , updateAt + + , iterate + , repeat + , cycle + , foldrLazy + , scanlLazy + } \ No newline at end of file diff --git a/test/Test/Args/LazyNonEmptyList.purs b/test/Test/Args/LazyNonEmptyList.purs new file mode 100644 index 0000000..99f2e20 --- /dev/null +++ b/test/Test/Args/LazyNonEmptyList.purs @@ -0,0 +1,126 @@ +module Test.Args.LazyNonEmptyList where + +import Data.List.Lazy.NonEmpty + +import Data.Foldable (class Foldable) +import Data.List.Lazy as L +import Data.Maybe (fromJust) +import Partial.Unsafe (unsafePartial) +import Prelude ((<<<)) +import Test.API (Common, CommonDiffEmptiability, OnlyNonEmpty, OnlyLazy) + +makeCollection :: forall a f. Foldable f => f a -> NonEmptyList a +makeCollection = unsafePartial fromJust <<< fromFoldable + +makeCanEmptyCollection :: forall a f. Foldable f => f a -> L.List a +makeCanEmptyCollection = L.fromFoldable + +makeNonEmptyCollection :: forall a f. Foldable f => f a -> NonEmptyList a +makeNonEmptyCollection = makeCollection + +common :: Common NonEmptyList +common = + { makeCollection + + , concat + , concatMap + , cons + , elemIndex + , elemLastIndex + , findIndex + , findLastIndex + , foldM + , index + , intersect + , intersectBy + , length + , nubEq + , nubByEq + , range + , reverse + , singleton + , snoc + , toUnfoldable + , union + , unionBy + , unzip + , zip + , zipWith + , zipWithA + + , appendFoldable + , insert + , insertBy + , nub + , nubBy + , some + , someRec + , sort + , sortBy + , transpose + } + +commonDiffEmptiability :: CommonDiffEmptiability NonEmptyList L.List L.List NonEmptyList Pattern +commonDiffEmptiability = + { makeCollection + , makeCanEmptyCollection + , makeNonEmptyCollection + + , catMaybes + , drop + , dropWhile + , filter + , filterM + , group + , groupAll + , groupBy + , mapMaybe + , partition + , span + , take + , takeEnd + , takeWhile + + , cons' + , delete + , deleteBy + , difference + , dropEnd + , groupAllBy + , pattern: Pattern + , slice + , snoc' + , stripPrefix + } + +onlyNonEmpty :: OnlyNonEmpty NonEmptyList L.List +onlyNonEmpty = + { makeCollection + , makeCanEmptyCollection + + , fromFoldable + , head + , init + , last + , tail + , uncons + + , fromList + , toList + } + +onlyLazy :: OnlyLazy NonEmptyList +onlyLazy = + { makeCollection + + , alterAt + , insertAt + , modifyAt + , updateAt + + , iterate + , repeat + , cycle + , foldrLazy + , scanlLazy + } \ No newline at end of file diff --git a/test/Test/Args/List.purs b/test/Test/Args/List.purs new file mode 100644 index 0000000..d1fcffe --- /dev/null +++ b/test/Test/Args/List.purs @@ -0,0 +1,121 @@ +module Test.Args.List where + +import Data.List + +import Data.Foldable (class Foldable) +import Data.List.NonEmpty as NEL +import Data.Maybe (fromJust) +import Partial.Unsafe (unsafePartial) +import Prelude ((<<<)) +import Test.API (Common, CommonDiffEmptiability, OnlyCanEmpty, OnlyStrict) + +makeCollection :: forall a f. Foldable f => f a -> List a +makeCollection = fromFoldable + +makeCanEmptyCollection :: forall a f. Foldable f => f a -> List a +makeCanEmptyCollection = fromFoldable + +makeNonEmptyCollection :: forall a f. Foldable f => f a -> NEL.NonEmptyList a +makeNonEmptyCollection = unsafePartial fromJust <<< NEL.fromFoldable + +common :: Common List +common = + { makeCollection + + , concat + , concatMap + , cons: Cons + , elemIndex + , elemLastIndex + , findIndex + , findLastIndex + , foldM + , index + , intersect + , intersectBy + , length + , nubEq + , nubByEq + , range + , reverse + , singleton + , snoc + , toUnfoldable + , union + , unionBy + , unzip + , zip + , zipWith + , zipWithA + + , appendFoldable + , insert + , insertBy + , nub + , nubBy + , some + , someRec + , sort + , sortBy + , transpose + } + +commonDiffEmptiability :: CommonDiffEmptiability List NEL.NonEmptyList List NEL.NonEmptyList Pattern +commonDiffEmptiability = + { makeCollection + , makeCanEmptyCollection + , makeNonEmptyCollection + + , catMaybes + , drop + , dropWhile + , filter + , filterM + , group + , groupAll + , groupBy + , mapMaybe + , partition + , span + , take + , takeEnd + , takeWhile + + , cons' + , delete + , deleteBy + , difference + , dropEnd + , groupAllBy + , pattern: Pattern + , slice + , snoc' + , stripPrefix + } + +onlyCanEmpty :: OnlyCanEmpty List NEL.NonEmptyList +onlyCanEmpty = + { makeCollection + , makeNonEmptyCollection + + , fromFoldable + , head + , init + , last + , tail + , uncons + + , null + , many + , manyRec + } + +onlyStrict :: OnlyStrict List +onlyStrict = + { makeCollection + + , alterAt + , insertAt + , modifyAt + , updateAt + } \ No newline at end of file diff --git a/test/Test/Args/NonEmptyList.purs b/test/Test/Args/NonEmptyList.purs new file mode 100644 index 0000000..ca4dfb3 --- /dev/null +++ b/test/Test/Args/NonEmptyList.purs @@ -0,0 +1,120 @@ +module Test.Args.NonEmptyList where + +import Data.List.NonEmpty + +import Data.Foldable (class Foldable) +import Data.List as L +import Data.Maybe (fromJust) +import Partial.Unsafe (unsafePartial) +import Prelude ((<<<)) +import Test.API (Common, CommonDiffEmptiability, OnlyNonEmpty, OnlyStrict) + +makeCollection :: forall a f. Foldable f => f a -> NonEmptyList a +makeCollection = unsafePartial fromJust <<< fromFoldable + +makeCanEmptyCollection :: forall a f. Foldable f => f a -> L.List a +makeCanEmptyCollection = L.fromFoldable + +makeNonEmptyCollection :: forall a f. Foldable f => f a -> NonEmptyList a +makeNonEmptyCollection = makeCollection + +common :: Common NonEmptyList +common = + { makeCollection + + , concat + , concatMap + , cons + , elemIndex + , elemLastIndex + , findIndex + , findLastIndex + , foldM + , index + , intersect + , intersectBy + , length + , nubEq + , nubByEq + , range + , reverse + , singleton + , snoc + , toUnfoldable + , union + , unionBy + , unzip + , zip + , zipWith + , zipWithA + + , appendFoldable + , insert + , insertBy + , nub + , nubBy + , some + , someRec + , sort + , sortBy + , transpose + } + +commonDiffEmptiability :: CommonDiffEmptiability NonEmptyList L.List L.List NonEmptyList Pattern +commonDiffEmptiability = + { makeCollection + , makeCanEmptyCollection + , makeNonEmptyCollection + + , catMaybes + , drop + , dropWhile + , filter + , filterM + , group + , groupAll + , groupBy + , mapMaybe + , partition + , span + , take + , takeEnd + , takeWhile + + , cons' + , delete + , deleteBy + , difference + , dropEnd + , groupAllBy + , pattern: Pattern + , slice + , snoc' + , stripPrefix + } + +onlyNonEmpty :: OnlyNonEmpty NonEmptyList L.List +onlyNonEmpty = + { makeCollection + , makeCanEmptyCollection + + , fromFoldable + , head + , init + , last + , tail + , uncons + + , fromList + , toList + } + +onlyStrict :: OnlyStrict NonEmptyList +onlyStrict = + { makeCollection + + , alterAt + , insertAt + , modifyAt + , updateAt + } \ No newline at end of file diff --git a/test/Test/CommonDiffEmptiability.purs b/test/Test/CommonDiffEmptiability.purs deleted file mode 100644 index bd37bba..0000000 --- a/test/Test/CommonDiffEmptiability.purs +++ /dev/null @@ -1,299 +0,0 @@ -module Test.CommonDiffEmptiability where - -import Prelude - -import Data.Foldable (class Foldable) -import Data.Function (on) -import Data.List as L -import Data.List.Lazy as LL -import Data.List.Lazy.NonEmpty as LNEL -import Data.List.NonEmpty as NEL -import Data.Maybe (Maybe(..), fromJust) -import Effect (Effect) -import Effect.Console (log) -import Partial.Unsafe (unsafePartial) -import Test.Assert (assert) -import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeCollection, range) - -{- -This is for testing common functions that have slightly different -signatures depending on whether the collection may be empty or not. -For example: - CanEmpty (as `c`): - drop :: forall a. Int -> c a -> c a - fromFoldable :: forall f. Foldable f => f ~> c - group :: forall a. Eq a => c a -> c (nonEmpty a) - head :: forall a. c a -> Maybe a - NonEmpty (as `c`): - drop :: forall a. Int -> c a -> canEmpty a - fromFoldable :: forall f a. Foldable f => f a -> Maybe (c a) - group :: forall a. Eq a => c a -> c (c a) - head :: forall a. c a -> a - -These are consolidated by providing different type constructors to the typeclass instances. - -This generally works, but cannot be done if `Maybe` is present in one of the versions. -So functions like `fromFoldable` and `head` must be tested elswhere with some duplication. -The original plan was to pass another function with the same kind signature as `Maybe`, -such as: - type Id x = x -But creating an "identity" type alias doesn't work because: - - First-class type families are required: - - https://stackoverflow.com/questions/63865620/can-haskell-type-synonyms-be-used-as-type-constructors - - Typeclasses only match on type constructors and not any arbritrary - type-level function with the same kind signature. - - https://old.reddit.com/r/haskell/comments/26dshj/why_doesnt_haskell_allow_type_aliases_in_the/ --} - - -class ( - Eq (c Int) -) <= CommonDiffEmptiability c cInverse canEmpty nonEmpty cPattern | c -> cInverse canEmpty nonEmpty cPattern where - - toCanEmpty :: forall a. c a -> canEmpty a - toNonEmpty :: forall a. c a -> nonEmpty a - - catMaybes :: forall a. c (Maybe a) -> canEmpty a - drop :: forall a. Int -> c a -> canEmpty a - dropWhile :: forall a. (a -> Boolean) -> c a -> canEmpty a - filter :: forall a. (a -> Boolean) -> c a -> canEmpty a - filterM :: forall m a. Monad m => (a -> m Boolean) -> c a -> m (canEmpty a) - group :: forall a. Eq a => c a -> c (nonEmpty a) - groupAll :: forall a. Ord a => c a -> c (nonEmpty a) - groupBy :: forall a. (a -> a -> Boolean) -> c a -> c (nonEmpty a) - mapMaybe :: forall a b. (a -> Maybe b) -> c a -> canEmpty b - partition :: forall a. (a -> Boolean) -> c a -> { no :: canEmpty a, yes :: canEmpty a } - span :: forall a. (a -> Boolean) -> c a -> { init :: canEmpty a, rest :: canEmpty a } - take :: forall a. Int -> c a -> canEmpty a - takeEnd :: forall a. Int -> c a -> canEmpty a - takeWhile :: forall a. (a -> Boolean) -> c a -> canEmpty a - - cons' :: forall a. a -> cInverse a -> c a - delete :: forall a. Eq a => a -> c a -> canEmpty a - deleteBy :: forall a. (a -> a -> Boolean) -> a -> c a -> canEmpty a - difference :: forall a. Eq a => c a -> c a -> canEmpty a - dropEnd :: forall a. Int -> c a -> canEmpty a - -- There's a pending PR to update this signature - -- groupAllBy :: forall a. (a -> a -> Ordering) -> c a -> c (nonEmpty a) - groupAllBy :: forall a. Ord a => (a -> a -> Boolean) -> c a -> c (nonEmpty a) - pattern :: forall a. c a -> cPattern a - slice :: Int -> Int -> c ~> canEmpty - snoc' :: forall a. cInverse a -> a -> c a - stripPrefix :: forall a. Eq a => cPattern a -> c a -> Maybe (canEmpty a) - -instance commonDiffEmptiabilityCanEmptyList :: CommonDiffEmptiability L.List NEL.NonEmptyList L.List NEL.NonEmptyList L.Pattern where - - toCanEmpty = identity - toNonEmpty = unsafePartial fromJust <<< NEL.fromList - - catMaybes = L.catMaybes - drop = L.drop - dropWhile = L.dropWhile - filter = L.filter - filterM = L.filterM - group = L.group - groupAll = L.groupAll - groupBy = L.groupBy - mapMaybe = L.mapMaybe - partition = L.partition - span = L.span - take = L.take - takeEnd = L.takeEnd - takeWhile = L.takeWhile - - cons' = L.cons' - delete = L.delete - deleteBy = L.deleteBy - difference = L.difference - dropEnd = L.dropEnd - groupAllBy = L.groupAllBy - pattern = L.Pattern - slice = L.slice - snoc' = L.snoc' - stripPrefix = L.stripPrefix - -instance commonDiffEmptiabilityNonEmptyList :: CommonDiffEmptiability NEL.NonEmptyList L.List L.List NEL.NonEmptyList NEL.Pattern where - - toCanEmpty = NEL.toList - toNonEmpty = identity - - catMaybes = NEL.catMaybes - drop = NEL.drop - dropWhile = NEL.dropWhile - filter = NEL.filter - filterM = NEL.filterM - group = NEL.group - groupAll = NEL.groupAll - groupBy = NEL.groupBy - mapMaybe = NEL.mapMaybe - partition = NEL.partition - span = NEL.span - take = NEL.take - takeEnd = NEL.takeEnd - takeWhile = NEL.takeWhile - - cons' = NEL.cons' - delete = NEL.delete - deleteBy = NEL.deleteBy - difference = NEL.difference - dropEnd = NEL.dropEnd - groupAllBy = NEL.groupAllBy - pattern = NEL.Pattern - slice = NEL.slice - snoc' = NEL.snoc' - stripPrefix = NEL.stripPrefix - -instance commonDiffEmptiabilityCanEmptyLazyList :: CommonDiffEmptiability LL.List LNEL.NonEmptyList LL.List LNEL.NonEmptyList LL.Pattern where - - toCanEmpty = identity - toNonEmpty = unsafePartial fromJust <<< LNEL.fromList - - catMaybes = LL.catMaybes - drop = LL.drop - dropWhile = LL.dropWhile - filter = LL.filter - filterM = LL.filterM - group = LL.group - groupAll = LL.groupAll - groupBy = LL.groupBy - mapMaybe = LL.mapMaybe - partition = LL.partition - span = LL.span - take = LL.take - takeEnd = LL.takeEnd - takeWhile = LL.takeWhile - - cons' = LL.cons' - delete = LL.delete - deleteBy = LL.deleteBy - difference = LL.difference - dropEnd = LL.dropEnd - groupAllBy = LL.groupAllBy - pattern = LL.Pattern - slice = LL.slice - snoc' = LL.snoc' - stripPrefix = LL.stripPrefix - -instance commonDiffEmptiabilityLazyNonEmptyList :: CommonDiffEmptiability LNEL.NonEmptyList LL.List LL.List LNEL.NonEmptyList LNEL.Pattern where - - toCanEmpty = LNEL.toList - toNonEmpty = identity - - catMaybes = LNEL.catMaybes - drop = LNEL.drop - dropWhile = LNEL.dropWhile - filter = LNEL.filter - filterM = LNEL.filterM - group = LNEL.group - groupAll = LNEL.groupAll - groupBy = LNEL.groupBy - mapMaybe = LNEL.mapMaybe - partition = LNEL.partition - span = LNEL.span - take = LNEL.take - takeEnd = LNEL.takeEnd - takeWhile = LNEL.takeWhile - - cons' = LNEL.cons' - delete = LNEL.delete - deleteBy = LNEL.deleteBy - difference = LNEL.difference - dropEnd = LNEL.dropEnd - groupAllBy = LNEL.groupAllBy - pattern = LNEL.Pattern - slice = LNEL.slice - snoc' = LNEL.snoc' - stripPrefix = LNEL.stripPrefix - -testCommonDiffEmptiability :: forall c cInverse canEmpty nonEmpty cPattern. - Common c => - CommonDiffEmptiability c cInverse canEmpty nonEmpty cPattern => - Eq (c (nonEmpty Int)) => - Eq (canEmpty Int) => - SkipBroken -> c Int -> canEmpty Int -> nonEmpty Int -> Effect Unit -testCommonDiffEmptiability skip _ nil _ = do - let - l :: forall f a. Foldable f => f a -> c a - l = makeCollection - - cel :: forall f a. Foldable f => f a -> canEmpty a - cel = toCanEmpty <<< l - - nel :: forall f a. Foldable f => f a -> nonEmpty a - nel = toNonEmpty <<< l - - assertSkip :: Array SkipBroken -> (_ -> Boolean) -> Effect Unit - assertSkip = assertSkipHelper skip - - printTestType "Common (where signatures differ based on emptiability)" - - --catMaybes :: forall a. c (Maybe a) -> c a - -- todo - - log "drop should remove the specified number of items from the front of an list" - assert $ (drop 1 (l [1, 2, 3])) == cel [2, 3] - assert $ (drop (-1) (l [1, 2, 3])) == cel [1, 2, 3] - - log "dropWhile should remove all values that match a predicate from the front of an list" - assert $ (dropWhile (_ /= 1) (l [1, 2, 3])) == cel [1, 2, 3] - assert $ (dropWhile (_ /= 2) (l [1, 2, 3])) == cel [2, 3] - --assert $ (dropWhile (_ /= 1) nil) == nil - - --filter :: forall a. (a -> Boolean) -> c a -> c a - -- todo - - --filterM :: forall m a. Monad m => (a -> m Boolean) -> c a -> m (c a) - -- todo - - log "group should group consecutive equal elements into lists" - assert $ group (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1], nel [2, 2], nel [3, 3, 3], nel [1]] - - log "groupAll should group equal elements into lists" - assertSkip [SkipBrokenLazyCanEmpty] - \_ -> groupAll (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1, 1], nel [2, 2], nel [3, 3, 3]] - --assert $ groupAll (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1, 1], nel [2, 2], nel [3, 3, 3]] - - log "groupBy should group consecutive equal elements into lists based on an equivalence relation" - assert $ groupBy (eq `on` (_ `mod` 10)) (l [1, 2, 12, 3, 13, 23, 11]) == l [nel [1], nel [2, 12], nel [3, 13, 23], nel [11]] - - -- todo - wait for this to be reworked - -- log "groupAllBy should group equal elements into lists based on an comparison function" - --assert $ groupAllBy (compare `on` mod 10) (l [1, 2, 12, 3, 13, 23, 11]) == l [nel [1, 11], nel [2, 12], nel [3, 13, 23]] - - log "mapMaybe should transform every item in an list, throwing out Nothing values" - assert $ mapMaybe (\x -> if x /= 0 then Just x else Nothing) (l [0, 1, 0, 0, 2, 3]) == cel [1, 2, 3] - - log "partition should separate a list into a tuple of lists that do and do not satisfy a predicate" - let partitioned = partition (_ > 2) (l [1, 5, 3, 2, 4]) - assert $ partitioned.yes == cel [5, 3, 4] - assert $ partitioned.no == cel [1, 2] - - log "span should split an list in two based on a predicate" - let spanResult = span (_ < 4) (l [1, 2, 3, 4, 5, 6, 7]) - assert $ spanResult.init == cel [1, 2, 3] - assert $ spanResult.rest == cel [4, 5, 6, 7] - - log "take should keep the specified number of items from the front of an list, discarding the rest" - assert $ (take 1 (l [1, 2, 3])) == cel [1] - assert $ (take 2 (l [1, 2, 3])) == cel [1, 2] - --assert $ (take 1 nil) == nil - assert $ (take 0 (l [1, 2])) == nil - assert $ (take (-1) (l [1, 2])) == nil - - log "takeEnd should keep the specified number of items from the end of an list, discarding the rest" - assertSkip [SkipBrokenLazyCanEmpty] - \_ -> (takeEnd 1 (l [1, 2, 3])) == cel [3] - assertSkip [SkipBrokenLazyCanEmpty] - \_ -> (takeEnd 2 (l [1, 2, 3])) == cel [2, 3] - assertSkip [SkipBrokenLazyCanEmpty] - \_ -> (takeEnd 2 (l [1])) == cel [1] - - --assert $ (takeEnd 1 (l [1, 2, 3])) == cel [3] - --assert $ (takeEnd 2 (l [1, 2, 3])) == cel [2, 3] - ----assert $ (takeEnd 1 nil) == nil - --assert $ (takeEnd 2 (l [1])) == cel [1] - - log "takeWhile should keep all values that match a predicate from the front of an list" - assert $ (takeWhile (_ /= 2) (l [1, 2, 3])) == cel [1] - assert $ (takeWhile (_ /= 3) (l [1, 2, 3])) == cel [1, 2] - --assert $ (takeWhile (_ /= 1) nil) == nil diff --git a/test/Test/CommonDiffEmptiabilityRecord.purs b/test/Test/CommonDiffEmptiabilityRecord.purs deleted file mode 100644 index 961daa0..0000000 --- a/test/Test/CommonDiffEmptiabilityRecord.purs +++ /dev/null @@ -1,211 +0,0 @@ -module Test.CommonDiffEmptiabilityRecord where - -import Prelude - -import Data.Foldable (class Foldable) -import Data.Function (on) -import Data.List as L -import Data.List.Lazy as LL -import Data.List.Lazy.NonEmpty as LNEL -import Data.List.NonEmpty as NEL -import Data.Maybe (Maybe(..), fromJust) -import Effect (Effect) -import Effect.Console (log) -import Partial.Unsafe (unsafePartial) -import Test.Assert (assert) -import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType) - ---type DeRec :: (Type -> Type) -> (Type -> Type) -> (Type -> Type) -> (Type -> Type) -> (Type -> Type) -> Type -type DeRec c cInverse canEmpty nonEmpty cPattern = - { makeCollection :: forall f a. Foldable f => f a -> c a - - , toCanEmpty :: forall a. c a -> canEmpty a - , toNonEmpty :: forall a. c a -> nonEmpty a - - , catMaybes :: forall a. c (Maybe a) -> canEmpty a - , drop :: forall a. Int -> c a -> canEmpty a - , dropWhile :: forall a. (a -> Boolean) -> c a -> canEmpty a - , filter :: forall a. (a -> Boolean) -> c a -> canEmpty a - , filterM :: forall m a. Monad m => (a -> m Boolean) -> c a -> m (canEmpty a) - , group :: forall a. Eq a => c a -> c (nonEmpty a) - , groupAll :: forall a. Ord a => c a -> c (nonEmpty a) - , groupBy :: forall a. (a -> a -> Boolean) -> c a -> c (nonEmpty a) - , mapMaybe :: forall a b. (a -> Maybe b) -> c a -> canEmpty b - , partition :: forall a. (a -> Boolean) -> c a -> { no :: canEmpty a, yes :: canEmpty a } - , span :: forall a. (a -> Boolean) -> c a -> { init :: canEmpty a, rest :: canEmpty a } - , take :: forall a. Int -> c a -> canEmpty a - , takeEnd :: forall a. Int -> c a -> canEmpty a - , takeWhile :: forall a. (a -> Boolean) -> c a -> canEmpty a - - , cons' :: forall a. a -> cInverse a -> c a - , delete :: forall a. Eq a => a -> c a -> canEmpty a - , deleteBy :: forall a. (a -> a -> Boolean) -> a -> c a -> canEmpty a - , difference :: forall a. Eq a => c a -> c a -> canEmpty a - , dropEnd :: forall a. Int -> c a -> canEmpty a - -- There's a pending PR to update this signature - -- groupAllBy :: forall a. (a -> a -> Ordering) -> c a -> c (nonEmpty a) - , groupAllBy :: forall a. Ord a => (a -> a -> Boolean) -> c a -> c (nonEmpty a) - , pattern :: forall a. c a -> cPattern a - , slice :: Int -> Int -> c ~> canEmpty - , snoc' :: forall a. cInverse a -> a -> c a - , stripPrefix :: forall a. Eq a => cPattern a -> c a -> Maybe (canEmpty a) -} - -testCommonDeRecBasic :: Effect Unit -testCommonDeRecBasic = - testDeRec RunAll L.Nil L.Nil (NEL.singleton 1) - { makeCollection = L.fromFoldable - , toCanEmpty = identity - , toNonEmpty = unsafePartial fromJust <<< NEL.fromList - - , catMaybes = L.catMaybes - , drop = L.drop - , dropWhile = L.dropWhile - , filter = L.filter - , filterM = L.filterM - , group = L.group - , groupAll = L.groupAll - , groupBy = L.groupBy - , mapMaybe = L.mapMaybe - , partition = L.partition - , span = L.span - , take = L.take - , takeEnd = L.takeEnd - , takeWhile = L.takeWhile - - , cons' = L.cons' - , delete = L.delete - , deleteBy = L.deleteBy - , difference = L.difference - , dropEnd = L.dropEnd - , groupAllBy = L.groupAllBy - , pattern = L.Pattern - , slice = L.slice - , snoc' = L.snoc' - , stripPrefix = L.stripPrefix - } - -testDeRec :: forall a c cInverse canEmpty nonEmpty cPattern. - -- Common c => - -- CommonDiffEmptiability c cInverse canEmpty nonEmpty cPattern => - Eq (c (nonEmpty a)) => - Eq (canEmpty a) => - SkipBroken -> c a -> canEmpty a -> nonEmpty a -> - DeRec c cInverse canEmpty nonEmpty cPattern -> - Effect Unit -testDeRec skip _ nil _ - { makeCollection - , toCanEmpty - , toNonEmpty - - , catMaybes - , drop - , dropWhile - , filter - , filterM - , group - , groupAll - , groupBy - , mapMaybe - , partition - , span - , take - , takeEnd - , takeWhile - - , cons' - , delete - , deleteBy - , difference - , dropEnd - , groupAllBy - , pattern - , slice - , snoc' - , stripPrefix - } = do - let - l :: forall f a. Foldable f => f a -> c a - l = makeCollection - - cel :: forall f a. Foldable f => f a -> canEmpty a - cel = toCanEmpty <<< l - - nel :: forall f a. Foldable f => f a -> nonEmpty a - nel = toNonEmpty <<< l - - assertSkip :: Array SkipBroken -> (_ -> Boolean) -> Effect Unit - assertSkip = assertSkipHelper skip - - printTestType "Common (where signatures differ based on emptiability)" - - --catMaybes :: forall a. c (Maybe a) -> c a - -- todo - - log "drop should remove the specified number of items from the front of an list" - assert $ (drop 1 (l [1, 2, 3])) == cel [2, 3] - assert $ (drop (-1) (l [1, 2, 3])) == cel [1, 2, 3] - - log "dropWhile should remove all values that match a predicate from the front of an list" - assert $ (dropWhile (_ /= 1) (l [1, 2, 3])) == cel [1, 2, 3] - assert $ (dropWhile (_ /= 2) (l [1, 2, 3])) == cel [2, 3] - --assert $ (dropWhile (_ /= 1) nil) == nil - - --filter :: forall a. (a -> Boolean) -> c a -> c a - -- todo - - --filterM :: forall m a. Monad m => (a -> m Boolean) -> c a -> m (c a) - -- todo - - log "group should group consecutive equal elements into lists" - assert $ group (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1], nel [2, 2], nel [3, 3, 3], nel [1]] - - log "groupAll should group equal elements into lists" - assertSkip [SkipBrokenLazyCanEmpty] - \_ -> groupAll (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1, 1], nel [2, 2], nel [3, 3, 3]] - --assert $ groupAll (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1, 1], nel [2, 2], nel [3, 3, 3]] - - log "groupBy should group consecutive equal elements into lists based on an equivalence relation" - assert $ groupBy (eq `on` (_ `mod` 10)) (l [1, 2, 12, 3, 13, 23, 11]) == l [nel [1], nel [2, 12], nel [3, 13, 23], nel [11]] - - -- todo - wait for this to be reworked - -- log "groupAllBy should group equal elements into lists based on an comparison function" - --assert $ groupAllBy (compare `on` mod 10) (l [1, 2, 12, 3, 13, 23, 11]) == l [nel [1, 11], nel [2, 12], nel [3, 13, 23]] - - log "mapMaybe should transform every item in an list, throwing out Nothing values" - assert $ mapMaybe (\x -> if x /= 0 then Just x else Nothing) (l [0, 1, 0, 0, 2, 3]) == cel [1, 2, 3] - - log "partition should separate a list into a tuple of lists that do and do not satisfy a predicate" - let partitioned = partition (_ > 2) (l [1, 5, 3, 2, 4]) - assert $ partitioned.yes == cel [5, 3, 4] - assert $ partitioned.no == cel [1, 2] - - log "span should split an list in two based on a predicate" - let spanResult = span (_ < 4) (l [1, 2, 3, 4, 5, 6, 7]) - assert $ spanResult.init == cel [1, 2, 3] - assert $ spanResult.rest == cel [4, 5, 6, 7] - - log "take should keep the specified number of items from the front of an list, discarding the rest" - assert $ (take 1 (l [1, 2, 3])) == cel [1] - assert $ (take 2 (l [1, 2, 3])) == cel [1, 2] - --assert $ (take 1 nil) == nil - assert $ (take 0 (l [1, 2])) == nil - assert $ (take (-1) (l [1, 2])) == nil - - log "takeEnd should keep the specified number of items from the end of an list, discarding the rest" - assertSkip [SkipBrokenLazyCanEmpty] - \_ -> (takeEnd 1 (l [1, 2, 3])) == cel [3] - assertSkip [SkipBrokenLazyCanEmpty] - \_ -> (takeEnd 2 (l [1, 2, 3])) == cel [2, 3] - assertSkip [SkipBrokenLazyCanEmpty] - \_ -> (takeEnd 2 (l [1])) == cel [1] - - --assert $ (takeEnd 1 (l [1, 2, 3])) == cel [3] - --assert $ (takeEnd 2 (l [1, 2, 3])) == cel [2, 3] - ----assert $ (takeEnd 1 nil) == nil - --assert $ (takeEnd 2 (l [1])) == cel [1] - - log "takeWhile should keep all values that match a predicate from the front of an list" - assert $ (takeWhile (_ /= 2) (l [1, 2, 3])) == cel [1] - assert $ (takeWhile (_ /= 3) (l [1, 2, 3])) == cel [1, 2] - --assert $ (takeWhile (_ /= 1) nil) == nil \ No newline at end of file diff --git a/test/Test/NoOverlap.purs b/test/Test/NoOverlap.purs deleted file mode 100644 index f563fa3..0000000 --- a/test/Test/NoOverlap.purs +++ /dev/null @@ -1,117 +0,0 @@ -module Test.NoOverlap where - -import Prelude - -import Effect (Effect) - -import Data.Foldable (class Foldable) -import Data.List as L -import Data.List.NonEmpty as NEL -import Data.List.Lazy as LL -import Data.List.Lazy.NonEmpty as LNEL -import Data.Maybe (Maybe(..)) - -import Test.Common (printTestType, makeCollection) - -import Effect.Console (log) -import Test.Assert (assert) - -{- -This file contains functions that cannot be tested generically. --} - - -assertSkip :: (_ -> Boolean) -> Effect Unit -assertSkip _ = - log "...skipped" - -testOnlyStrictCanEmpty :: Effect Unit -testOnlyStrictCanEmpty = do - - let - l :: forall f a. Foldable f => f a -> L.List a - l = makeCollection - - printTestType "Only Strict canEmpty" - - -- Common function names, but different signatures - - log "deleteAt should remove an item at the specified index" - assert $ L.deleteAt 0 (l [1, 2, 3]) == Just (l [2, 3]) - assert $ L.deleteAt 1 (l [1, 2, 3]) == Just (l [1, 3]) - - -- Corner Cases - - -- Unique functions - - -testOnlyStrictNonEmpty :: Effect Unit -testOnlyStrictNonEmpty = do - - let - l :: forall f a. Foldable f => f a -> NEL.NonEmptyList a - l = makeCollection - - cel :: forall f a. Foldable f => f a -> L.List a - cel = makeCollection - - printTestType "Only Strict NonEmpty" - - -- Common function names, but different signatures - - log "deleteAt should remove an item at the specified index" - assertSkip \_ -> NEL.deleteAt 0 (l [1, 2, 3]) == Just (cel [2, 3]) - assertSkip \_ -> NEL.deleteAt 1 (l [1, 2, 3]) == Just (cel [1, 3]) - - -- Corner Cases - - -- Unique functions - - -testOnlyLazyCanEmpty :: Effect Unit -testOnlyLazyCanEmpty = do - - let - l :: forall f a. Foldable f => f a -> LL.List a - l = makeCollection - - printTestType "Only Lazy canEmpty" - - -- Common function names, but different signatures - - log "deleteAt should remove an item at the specified index" - assert $ LL.deleteAt 0 (l [1, 2, 3]) == l [2, 3] - assert $ LL.deleteAt 1 (l [1, 2, 3]) == l [1, 3] - - -- Corner Cases - - -- Unique functions - - -- replicate (specialized from Unfoldable's replicate) - -- replicateM (specialized from Unfoldable's replicateA) - - -testOnlyLazyNonEmpty :: Effect Unit -testOnlyLazyNonEmpty = do - - let - l :: forall f a. Foldable f => f a -> LNEL.NonEmptyList a - l = makeCollection - - cel :: forall f a. Foldable f => f a -> LL.List a - cel = makeCollection - - printTestType "Only Lazy NonEmpty" - - -- Common function names, but different signatures - - log "deleteAt should remove an item at the specified index" - assert $ LNEL.deleteAt 0 (l [1, 2, 3]) == cel [2, 3] - assert $ LNEL.deleteAt 1 (l [1, 2, 3]) == cel [1, 3] - - -- Corner Cases - - -- Unique functions - - -- replicate1 (specialized from Unfoldable1's replicate1) - -- replicate1M (specialized from Unfoldable1's replicate1A) \ No newline at end of file diff --git a/test/Test/OnlyCanEmpty.purs b/test/Test/OnlyCanEmpty.purs deleted file mode 100644 index 8f87b49..0000000 --- a/test/Test/OnlyCanEmpty.purs +++ /dev/null @@ -1,183 +0,0 @@ -module Test.OnlyCanEmpty where - -import Prelude - -import Control.Alternative (class Alternative) -import Control.Lazy (class Lazy) -import Control.Monad.Rec.Class (class MonadRec) -import Control.MonadPlus (class MonadPlus) -import Control.MonadZero (class MonadZero) -import Control.Plus (class Plus, empty) -import Data.Foldable (class Foldable) -import Data.List as L -import Data.List.Lazy as LL -import Data.List.Lazy.NonEmpty as LNEL -import Data.List.NonEmpty as NEL -import Data.Maybe (Maybe(..), fromJust, isNothing) -import Data.Tuple (Tuple(..)) -import Data.Unfoldable (class Unfoldable, unfoldr) -import Effect (Effect) -import Effect.Console (log) -import Partial.Unsafe (unsafePartial) -import Test.Assert (assert) -import Test.Common (class Common, makeCollection, printTestType, range) - -class ( - Alternative c - , MonadPlus c - , MonadZero c - , Monoid (c Int) -- Monoid1? - , Plus c - , Unfoldable c -) <= OnlyCanEmpty c nonEmpty | c -> nonEmpty, nonEmpty -> c where - - makeNonEmptyCollection :: forall f a. Foldable f => f a -> nonEmpty a - - -- These are the same function names as the NonEmpty versions, - -- but the signatures are different and can't be merged in the - -- CommonDiffEmptiability tests. This is due to a mismatch in the - -- presence of `Maybe`s. - fromFoldable :: forall f. Foldable f => f ~> c - head :: forall a. c a -> Maybe a - init :: forall a. c a -> Maybe (c a) - last :: forall a. c a -> Maybe a - tail :: forall a. c a -> Maybe (c a) - uncons :: forall a. c a -> Maybe { head :: a, tail :: c a } - - -- These are not available for non-empty collections - null :: forall a. c a -> Boolean - many :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) - manyRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) - -instance onlyCanEmptyList :: OnlyCanEmpty L.List NEL.NonEmptyList where - - makeNonEmptyCollection = unsafePartial fromJust <<< NEL.fromFoldable - - fromFoldable = L.fromFoldable - head = L.head - init = L.init - last = L.last - tail = L.tail - uncons = L.uncons - - null = L.null - many = L.many - manyRec = L.manyRec - -instance onlyCanEmptyLazyList :: OnlyCanEmpty LL.List LNEL.NonEmptyList where - - makeNonEmptyCollection = unsafePartial fromJust <<< LNEL.fromFoldable - - fromFoldable = LL.fromFoldable - head = LL.head - init = LL.init - last = LL.last - tail = LL.tail - uncons = LL.uncons - - null = LL.null - many = LL.many - manyRec = LL.manyRec - - -testOnlyCanEmpty :: forall c nonEmpty. - Common c => - OnlyCanEmpty c nonEmpty => - Eq (c Int) => - Eq (c (nonEmpty Int)) => - c Int -> nonEmpty Int -> Effect Unit -testOnlyCanEmpty nil _ = do - let - l :: forall f a. Foldable f => f a -> c a - l = makeCollection - - nel :: forall f a. Foldable f => f a -> nonEmpty a - nel = makeNonEmptyCollection - - rg :: Int -> Int -> c Int - rg = range - - printTestType "Only canEmpty" - - -- ======= Typeclass tests ======== - - -- Alternative - -- applicative and plus - -- (f <|> g) <*> x == (f <*> x) <|> (g <*> x) - -- empty <*> f == empty - - -- MonadPlus - -- Additional law on MonadZero - -- (x <|> y) >>= f == (x >>= f) <|> (y >>= f) - - -- MonadZero - -- monad and alternative - -- empty >>= f = empty - - -- Monoid - -- mempty :: c - log "mempty should not change the collection it is appended to" - assert $ l [5] <> mempty == l [5] - log "mempty should be an empty collection" - assert $ l [] == (mempty :: c Int) - - -- Plus - -- empty :: forall a. c a - log "empty should create an empty collection" - assert $ l [] == (empty :: c Int) - - -- Unfoldable - -- unfoldr :: forall a b. (b -> Maybe (Tuple a b)) -> b -> c a - - log "unfoldr should maintain order" - let - step :: Int -> Maybe (Tuple Int Int) - step 6 = Nothing - step n = Just (Tuple n (n + 1)) - assert $ rg 1 5 == unfoldr step 1 - - - -- ======= Functions tests ======== - - --fromFoldable :: forall f. Foldable f => f ~> c - --already extensively checked in common tests - - -- These are the remaining functions that can't be deduplicated due to use of Maybe - - -- Todo - double-check the phrasing on these? Might be confusing to refer to a - -- non-empty canEmpty list. - - log "head should return a Just-NEL.NonEmptyListped first value of a non-empty list" - assert $ head (l [1, 2]) == Just 1 - - log "head should return Nothing for an empty list" - assert $ head nil == Nothing - - -- Todo - phrasing should be changed to note all but last (not all but first). - log "init should return a Just-NEL.NonEmptyListped list containing all the items in an list apart from the first for a non-empty list" - assert $ init (l [1, 2, 3]) == Just (l [1, 2]) - - log "init should return Nothing for an empty list" - assert $ init nil == Nothing - - - log "last should return a Just-NEL.NonEmptyListped last value of a non-empty list" - assert $ last (l [1, 2]) == Just 2 - - log "last should return Nothing for an empty list" - assert $ last nil == Nothing - - - log "tail should return a Just-NEL.NonEmptyListped list containing all the items in an list apart from the first for a non-empty list" - assert $ tail (l [1, 2, 3]) == Just (l [2, 3]) - - log "tail should return Nothing for an empty list" - assert $ tail nil == Nothing - - - log "uncons should return nothing when used on an empty list" - assert $ isNothing (uncons nil) - - log "uncons should split an list into a head and tail record when there is at least one item" - assert $ uncons (l [1]) == Just {head: 1, tail: l []} - assert $ uncons (l [1, 2, 3]) == Just {head: 1, tail: l [2, 3]} diff --git a/test/Test/OnlyLazy.purs b/test/Test/OnlyLazy.purs deleted file mode 100644 index 2b4a66c..0000000 --- a/test/Test/OnlyLazy.purs +++ /dev/null @@ -1,86 +0,0 @@ -module Test.OnlyLazy where - -import Prelude - -import Data.Foldable (class Foldable) -import Data.Maybe (Maybe(..)) -import Control.Lazy (class Lazy) -import Effect (Effect) -import Effect.Console (log) -import Test.Assert (assert) - -import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeCollection) - -import Data.List.Lazy as LL -import Data.List.Lazy.NonEmpty as LNEL - -{- -class ( - Lazy (c Int) -- missing from LazyNonEmptyList -) <= OnlyLazy c where --} - -class OnlyLazy c where - --- Same names, but different APIs (without Maybe) - alterAt :: forall a. Int -> (a -> Maybe a) -> c a -> c a - insertAt :: forall a. Int -> a -> c a -> c a - modifyAt :: forall a. Int -> (a -> a) -> c a -> c a - updateAt :: forall a. Int -> a -> c a -> c a - - -- These are only available for Lazy collections - iterate :: forall a. (a -> a) -> a -> c a - repeat :: forall a. a -> c a - cycle :: forall a. c a -> c a - foldrLazy :: forall a b. Lazy b => (a -> b -> b) -> b -> c a -> b - scanlLazy :: forall a b. (b -> a -> b) -> b -> c a -> c b - - -instance onlyLazyList :: OnlyLazy LL.List where - alterAt = LL.alterAt - insertAt = LL.insertAt - modifyAt = LL.modifyAt - updateAt = LL.updateAt - - iterate = LL.iterate - repeat = LL.repeat - cycle = LL.cycle - foldrLazy = LL.foldrLazy - scanlLazy = LL.scanlLazy - -instance onlyLazyNonEmptyList :: OnlyLazy LNEL.NonEmptyList where - alterAt = LNEL.alterAt - insertAt = LNEL.insertAt - modifyAt = LNEL.modifyAt - updateAt = LNEL.updateAt - - iterate = LNEL.iterate - repeat = LNEL.repeat - cycle = LNEL.cycle - foldrLazy = LNEL.foldrLazy - scanlLazy = LNEL.scanlLazy - -testOnlyLazy :: forall c. - Common c => - OnlyLazy c => - c Int -> Effect Unit -testOnlyLazy _ = do - let - l :: forall f a. Foldable f => f a -> c a - l = makeCollection - - printTestType "Only Lazy" - - log "insertAt should add an item at the specified index" - assert $ (insertAt 0 1 (l [2, 3])) == (l [1, 2, 3]) - assert $ (insertAt 1 1 (l [2, 3])) == (l [2, 1, 3]) - assert $ (insertAt 2 1 (l [2, 3])) == (l [2, 3, 1]) - - log "modifyAt should update an item at the specified index" - assert $ (modifyAt 0 (_ + 1) (l [1, 2, 3])) == (l [2, 2, 3]) - assert $ (modifyAt 1 (_ + 1) (l [1, 2, 3])) == (l [1, 3, 3]) - - log "updateAt should replace an item at the specified index" - assert $ (updateAt 0 9 (l [1, 2, 3])) == (l [9, 2, 3]) - assert $ (updateAt 1 9 (l [1, 2, 3])) == (l [1, 9, 3]) - diff --git a/test/Test/OnlyNonEmpty.purs b/test/Test/OnlyNonEmpty.purs deleted file mode 100644 index cbd17cc..0000000 --- a/test/Test/OnlyNonEmpty.purs +++ /dev/null @@ -1,123 +0,0 @@ -module Test.OnlyNonEmpty where - -import Prelude - -import Control.Comonad (class Comonad) -import Data.Foldable (class Foldable, foldMap, foldl) -import Data.List as L -import Data.List.Lazy as LL -import Data.List.Lazy.NonEmpty as LNEL -import Data.List.NonEmpty as NEL -import Data.Maybe (Maybe(..)) -import Data.Semigroup.Foldable (class Foldable1) -import Data.Semigroup.Traversable (class Traversable1) -import Effect (Effect) -import Effect.Console (log) -import Test.Assert (assert, assertEqual) -import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeCollection) - -class ( - Comonad c - --, Foldable1 c -- missing from LazyNonEmptyList - --, Traversable1 c -- missing from LazyNonEmptyList -) <= OnlyNonEmpty c canEmpty | c -> canEmpty, canEmpty -> c where - - makeCanEmptyCollection :: forall f a. Foldable f => f a -> canEmpty a - - -- These are the same function names as the CanEmpty versions, - -- but the signatures are different and can't be merged in the - -- CommonDiffEmptiability tests. This is due to a mismatch in the - -- presence of `Maybe`s. - - fromFoldable :: forall f a. Foldable f => f a -> Maybe (c a) - head :: forall a. c a -> a - init :: forall a. c a -> canEmpty a - last :: forall a. c a -> a - tail :: forall a. c a -> canEmpty a - uncons :: forall a. c a -> { head :: a, tail :: canEmpty a } - - -- These are only available for NonEmpty collections - - fromList :: forall a. canEmpty a -> Maybe (c a) - toList :: c ~> canEmpty - -instance onlyNonEmptyList :: OnlyNonEmpty NEL.NonEmptyList L.List where - - makeCanEmptyCollection = L.fromFoldable - - fromFoldable = NEL.fromFoldable - head = NEL.head - init = NEL.init - last = NEL.last - tail = NEL.tail - uncons = NEL.uncons - - fromList = NEL.fromList - toList = NEL.toList - -instance onlyNonEmptyLazyList :: OnlyNonEmpty LNEL.NonEmptyList LL.List where - - makeCanEmptyCollection = LL.fromFoldable - - fromFoldable = LNEL.fromFoldable - head = LNEL.head - init = LNEL.init - last = LNEL.last - tail = LNEL.tail - uncons = LNEL.uncons - - fromList = LNEL.fromList - toList = LNEL.toList - -testOnlyNonEmpty :: forall c canEmpty. - Common c => - OnlyNonEmpty c canEmpty => - Eq (c Int) => - Eq (canEmpty Int) => - Show (canEmpty Int) => - c Int -> canEmpty Int -> Effect Unit -testOnlyNonEmpty _ _ = do - let - l :: forall f a. Foldable f => f a -> c a - l = makeCollection - - cel :: forall f a. Foldable f => f a -> canEmpty a - cel = makeCanEmptyCollection - - printTestType "Only nonEmpty" - - -- ======= Typeclass tests ======== - - -- Todo - - -- Comonad - -- Foldable1 - -- Traversable1 - - -- ======= Functions tests ======== - - log "fromList should convert from a List to a NonEmptyList" - assertEqual { actual: fromList $ cel [1, 2, 3], expected: Just $ l [1, 2, 3] } - assertEqual { actual: fromList $ cel ([] :: _ Int), expected: Nothing } - - log "toList should convert from a NonEmptyList to a List" - assertEqual { actual: toList $ l [1, 2, 3], expected: cel [1, 2, 3] } - - - -- These are the remaining functions that can't be deduplicated due to use of Maybe - - log "head should return a the first value" - assert $ head (l [1, 2]) == 1 - - log "init should return a canEmpty collection of all but the last value" - assert $ init (l [1, 2, 3]) == cel [1, 2] - - log "last should return the last value" - assert $ last (l [1, 2]) == 2 - - log "tail should return a canEmpty collection of all but the first value" - assert $ tail (l [1, 2, 3]) == cel [2, 3] - - log "uncons should split a collection into a record containing the first and remaining values" - assert $ uncons (l [1]) == {head: 1, tail: cel []} - assert $ uncons (l [1, 2, 3]) == {head: 1, tail: cel [2, 3]} diff --git a/test/Test/OnlyStrict.purs b/test/Test/OnlyStrict.purs deleted file mode 100644 index 553db0b..0000000 --- a/test/Test/OnlyStrict.purs +++ /dev/null @@ -1,79 +0,0 @@ -module Test.OnlyStrict where - -import Prelude - -import Data.Foldable (class Foldable) -import Data.Maybe (Maybe(..)) -import Effect (Effect) -import Effect.Console (log) -import Test.Assert (assert) - -import Test.Common (class Common, SkipBroken(..), assertSkipHelper, printTestType, makeCollection) - -import Data.List as L -import Data.List.NonEmpty as NEL - -class OnlyStrict c where --- Potentially just these functions: --- Seems like they could also be common -{- -group' -mapWithIndex -sort -sortBy -unsnoc --} - - -- Same names, but different APIs (with Maybe) - alterAt :: forall a. Int -> (a -> Maybe a) -> c a -> Maybe (c a) - insertAt :: forall a. Int -> a -> c a -> Maybe (c a) - modifyAt :: forall a. Int -> (a -> a) -> c a -> Maybe (c a) - updateAt :: forall a. Int -> a -> c a -> Maybe (c a) - - -- Strict only - -- recently fixed, so now common - --nub :: forall a. Ord a => c a -> c a - --nubBy :: forall a. (a -> a -> Ordering) -> c a -> c a - -instance onlyStrictList :: OnlyStrict L.List where - alterAt = L.alterAt - insertAt = L.insertAt - modifyAt = L.modifyAt - updateAt = L.updateAt - -instance onlyStrictNonEmptyList :: OnlyStrict NEL.NonEmptyList where - alterAt = NEL.alterAt - insertAt = NEL.insertAt - modifyAt = NEL.modifyAt - updateAt = NEL.updateAt - - - -testOnlyStrict :: forall c. - Common c => - OnlyStrict c => - c Int -> Effect Unit -testOnlyStrict _ = do - - let - l :: forall f a. Foldable f => f a -> c a - l = makeCollection - - printTestType "Only Strict" - - -- todo insertAt test - -- missing from original test suite - - -- todo modifyAt test - -- missing from original test suite - - log "updateAt should replace an item at the specified index" - assert $ (updateAt 0 9 (l [1, 2, 3])) == Just (l [9, 2, 3]) - assert $ (updateAt 1 9 (l [1, 2, 3])) == Just (l [1, 9, 3]) - - log "updateAt should return Nothing if the index is out of range" - assert $ (updateAt 5 9 (l [1, 2, 3])) == Nothing - - - - diff --git a/test/Test/UpdatedTests.purs b/test/Test/UpdatedTests.purs index 1708854..ad9ed0a 100644 --- a/test/Test/UpdatedTests.purs +++ b/test/Test/UpdatedTests.purs @@ -7,14 +7,11 @@ import Data.List.Lazy as LL import Data.List.Lazy.NonEmpty as LNEL import Data.List.NonEmpty as NEL import Effect (Effect) -import Test.Common (testCommon, SkipBroken(..), printCollectionType) -import Test.CommonDiffEmptiability (testCommonDiffEmptiability) -import Test.NoOverlap (testOnlyLazyCanEmpty, testOnlyLazyNonEmpty, testOnlyStrictCanEmpty, testOnlyStrictNonEmpty) -import Test.OnlyCanEmpty (testOnlyCanEmpty) -import Test.OnlyLazy (testOnlyLazy) -import Test.OnlyNonEmpty (testOnlyNonEmpty) -import Test.OnlyStrict (testOnlyStrict) - +import Test.AllTests as T +import Test.Args.LazyList as LLA +import Test.Args.LazyNonEmptyList as LNELA +import Test.Args.List as LA +import Test.Args.NonEmptyList as NELA {- --- Next steps: @@ -50,48 +47,48 @@ updatedTests = do testBasicList :: Effect Unit testBasicList = do - printCollectionType "Basic List" + T.printCollectionType "Basic List" - testCommon nil - testCommonDiffEmptiability RunAll nil nil nonEmpty - testOnlyCanEmpty nil nonEmpty - testOnlyStrict nil - testOnlyStrictCanEmpty + T.testCommon LA.common + T.testCommonDiffEmptiability T.RunAll LA.commonDiffEmptiability + T.testOnlyCanEmpty LA.onlyCanEmpty + T.testOnlyStrict LA.onlyStrict + T.testOnlyStrictCanEmpty testNonEmptyList :: Effect Unit testNonEmptyList = do - printCollectionType "NonEmpty List" + T.printCollectionType "NonEmpty List" - testCommon nonEmpty - testCommonDiffEmptiability RunAll nonEmpty nil nonEmpty - testOnlyNonEmpty nonEmpty nil - testOnlyStrict nonEmpty - testOnlyStrictNonEmpty + T.testCommon NELA.common + T.testCommonDiffEmptiability T.SkipBrokenStrictNonEmpty NELA.commonDiffEmptiability + T.testOnlyNonEmpty NELA.onlyNonEmpty + T.testOnlyStrict NELA.onlyStrict + T.testOnlyStrictNonEmpty testLazyList :: Effect Unit testLazyList = do - printCollectionType "Lazy List" + T.testCommon LLA.common + T.testCommonDiffEmptiability T.SkipBrokenLazyCanEmpty LLA.commonDiffEmptiability + T.testOnlyCanEmpty LLA.onlyCanEmpty + T.testOnlyLazy LLA.onlyLazy + T.testOnlyStrictCanEmpty + T.testOnlyLazyCanEmpty - testCommon lazyNil - testCommonDiffEmptiability SkipBrokenLazyCanEmpty lazyNil lazyNil lazyNonEmpty - testOnlyCanEmpty lazyNil lazyNonEmpty - testOnlyLazy lazyNil - testOnlyLazyCanEmpty testLazyNonEmptyList :: Effect Unit testLazyNonEmptyList = do - printCollectionType "Lazy NonEmpty List" + T.printCollectionType "Lazy NonEmpty List" -- So much stuff is unsupported for this collection that it's not yet -- worth using the assertSkip strategy - testCommon lazyNonEmpty - testCommonDiffEmptiability RunAll lazyNonEmpty lazyNil lazyNonEmpty - testOnlyNonEmpty lazyNonEmpty lazyNil - testOnlyLazy lazyNonEmpty - testOnlyLazyNonEmpty + T.testCommon LNELA.common + T.testCommonDiffEmptiability T.RunAll LNELA.commonDiffEmptiability + T.testOnlyNonEmpty LNELA.onlyNonEmpty + T.testOnlyLazy LNELA.onlyLazy + T.testOnlyLazyNonEmpty -- nil is passed instead of a singleton, -- because some of the functions use this From 4164c1fd59613d595614f95d3bd01183b891cd5f Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Sun, 2 May 2021 14:06:07 -0700 Subject: [PATCH 11/18] compilation checkpoint - missing implementations --- test/Test/AllTests.purs | 56 +++++++++++++++++++++++++---------------- 1 file changed, 35 insertions(+), 21 deletions(-) diff --git a/test/Test/AllTests.purs b/test/Test/AllTests.purs index ff68d55..616dee0 100644 --- a/test/Test/AllTests.purs +++ b/test/Test/AllTests.purs @@ -410,13 +410,7 @@ testCommon -- assertEqual { actual: modifyAt 7 (_ + 1) $ l [1,2,3], expected: Nothing } log "nubEq should remove duplicate elements from the collection, keeping the first occurence" - -- let - -- thing :: c Int - -- thing = l [1, 2, 2, 3, 4, 1] - -- res = r.nubEq $ thing - --assertEqual { actual: r.nubEq $ thing, expected: l [1, 2, 3, 4] } - -- Todo - very confused why this won't work - --assertEqual { actual: nubEq $ l [1, 2, 2, 3, 4, 1], expected: l [1, 2, 3, 4] } + assertEqual { actual: nubEq (l [1, 2, 2, 3, 4, 1]), expected: l [1, 2, 3, 4] } log "nubByEq should remove duplicate items from the collection using a supplied predicate" let mod3eq = eq `on` \n -> mod n 3 @@ -437,6 +431,8 @@ testCommon assertEqual { actual: l [1, 2, 3] `snoc` 4, expected: l [1, 2, 3, 4] } -- Todo toUnfoldable + --toUnfoldable :: forall f a. Unfoldable f => c a -> f a + log "union should produce the union of two collections" assertEqual { actual: union (l [1, 2, 3]) $ l [2, 3, 4], expected: l [1, 2, 3, 4] } @@ -464,30 +460,48 @@ testCommon -- sort into above -} - -- appendFoldable :: forall t a. Foldable t => c a -> t a -> c a - -- todo + log "appendFoldable should append a foldable collection to another collection" + -- todo - missing for basic list + assertEqual { actual: appendFoldable (l [1, 2, 3]) [4, 5], expected: l [1, 2, 3, 4, 5] } - {- -- Todo - clean these up log "insert should add an item at the appropriate place in a sorted list" - assert $ insert 2 (l [1, 1, 3]) == l [1, 1, 2, 3] - assert $ insert 4 (l [1, 2, 3]) == l [1, 2, 3, 4] - assert $ insert 0 (l [1, 2, 3]) == l [0, 1, 2, 3] + assertEqual { actual: insert 2 $ l [1, 1, 3], expected: l [1, 1, 2, 3] } + assertEqual { actual: insert 4 $ l [1, 2, 3], expected: l [1, 2, 3, 4] } + assertEqual { actual: insert 0 $ l [1, 2, 3], expected: l [0, 1, 2, 3] } - log "insertBy should add an item at the appropriate place in a sorted list using the specified comparison" - assert $ insertBy (flip compare) 4 (l [1, 2, 3]) == l [4, 1, 2, 3] - assert $ insertBy (flip compare) 0 (l [1, 2, 3]) == l [1, 2, 3, 0] + log "insertBy should add an item at the appropriate place in a sorted collection using the specified comparison" + assertEqual { actual: insertBy (flip compare) 4 $ l [1, 2, 3], expected: l [4, 1, 2, 3] } + assertEqual { actual: insertBy (flip compare) 0 $ l [1, 2, 3], expected: l [1, 2, 3, 0] } -- nub :: forall a. Ord a => c a -> c a -- nubBy :: forall a. (a -> a -> Ordering) -> c a -> c a - log "nub should remove duplicate elements from the list, keeping the first occurrence" - assert $ nub (l [1, 2, 2, 3, 4, 1]) == l [1, 2, 3, 4] + log "nub should remove duplicate elements from a collection, keeping the first occurrence" + assertEqual { actual: nub (l [1, 2, 2, 3, 4, 1]), expected: l [1, 2, 3, 4] } - log "nubBy should remove duplicate items from the list using a supplied predicate" - assert $ nubBy (compare `on` Array.length) (l [[1],[2],[3,4]]) == l [[1],[3,4]] - -} + log "nubBy should remove duplicate items from a collection using a supplied predicate" + assertEqual { actual: nubBy (compare `on` Array.length) $ l [[1],[2],[3,4]] , expected: l [[1],[3,4]] } + + -- some :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) + -- someRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) + -- sort :: forall a. Ord a => c a -> c a + -- sortBy :: forall a. (a -> a -> Ordering) -> c a -> c a + + log "sort should reorder a collection into ascending order based on the result of compare" + assertEqual { actual: sort (l [1, 3, 2, 5, 6, 4]), expected: l [1, 2, 3, 4, 5, 6] } + + log "sortBy should reorder a collection into ascending order based on the result of a comparison function" + assertEqual { actual: sortBy (flip compare) $ l [1, 3, 2, 5, 6, 4] + , expected: l [6, 5, 4, 3, 2, 1] } + + log "transpose should swap 'rows' and 'columns' of a collection of collections" + assertEqual { actual: transpose (l [l [1,2,3], l[4,5,6], l [7,8,9]]) + , expected: l [l [1,4,7], l[2,5,8], l [3,6,9]] } + log "transpose should skip elements when row lengths don't match" + assertEqual { actual: transpose (l [l [10, 11], l [20], l [30, 31, 32]]) + , expected: l [l [10, 20, 30], l [11, 31], l [32]] } {- From 75eb742eb909a3e9d181b47f9bbe6073ac9af820 Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Mon, 3 May 2021 06:40:04 -0700 Subject: [PATCH 12/18] another checkpoint --- src/Data/List.purs | 20 +++-- test/Test/API.purs | 1 + test/Test/AllTests.purs | 151 +++++++++++++++++++----------------- test/Test/UpdatedTests.purs | 4 +- 4 files changed, 98 insertions(+), 78 deletions(-) diff --git a/src/Data/List.purs b/src/Data/List.purs index 89bde1f..75d4617 100644 --- a/src/Data/List.purs +++ b/src/Data/List.purs @@ -18,6 +18,7 @@ module Data.List , someRec , many , manyRec + -- , replicate -- questionable specialization , null , length @@ -116,7 +117,7 @@ import Data.Foldable (foldl, foldr, foldMap, fold, intercalate, elem, notElem, f import Data.FunctorWithIndex (mapWithIndex) as FWI import Data.List.Internal (emptySet, insertAndLookupBy) import Data.List.Types (List(..), (:)) -import Data.List.Types (NonEmptyList(..)) as NEL +import Data.List.Types as NEL import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype) import Data.NonEmpty ((:|)) @@ -124,19 +125,19 @@ import Data.Traversable (scanl, scanr) as Exports import Data.Traversable (sequence) import Data.Tuple (Tuple(..)) import Data.Unfoldable (class Unfoldable, unfoldr) -import Partial.Unsafe (unsafeCrashWith) import Prim.TypeError (class Warn, Text) ---------- Additions appendFoldable :: forall t a. Foldable t => List a -> t a -> List a -appendFoldable _ _ = unsafeCrashWith "todo appendFoldable for Basic List" +appendFoldable xs ys = xs <> fromFoldable ys cons' :: forall a. a -> NEL.NonEmptyList a -> List a -cons' _ _ = unsafeCrashWith "todo cons' for Basic List" +cons' x xs = Cons x $ NEL.toList xs + snoc' :: forall a. NEL.NonEmptyList a -> a -> List a -snoc' _ _ = unsafeCrashWith "todo snoc' for Basic List" +snoc' xs x = snoc (NEL.toList xs) x -- | Convert a list into any unfoldable structure. -- | @@ -199,6 +200,15 @@ manyRec p = tailRecM go Nil aa <- (Loop <$> p) <|> pure (Done unit) pure $ bimap (_ : acc) (\_ -> reverse acc) aa +-- Questionable whether this should be specialized +-- -- | Create a list containing a value repeated n times +-- replicate :: forall a. Int -> a -> List a +-- replicate num x = go num Nil +-- where +-- go n xs | n < 1 = xs +-- | otherwise = go (n - 1) (x : xs) + + -------------------------------------------------------------------------------- -- List size ------------------------------------------------------------------- -------------------------------------------------------------------------------- diff --git a/test/Test/API.purs b/test/Test/API.purs index c3441d6..0eaa04a 100644 --- a/test/Test/API.purs +++ b/test/Test/API.purs @@ -44,6 +44,7 @@ type Common c = , insertBy :: forall a. (a -> a -> Ordering) -> a -> c a -> c a , nub :: forall a. Ord a => c a -> c a , nubBy :: forall a. (a -> a -> Ordering) -> c a -> c a + , replicate :: forall a. Int -> a -> c a , some :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) , someRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) , sort :: forall a. Ord a => c a -> c a diff --git a/test/Test/AllTests.purs b/test/Test/AllTests.purs index 616dee0..2495f52 100644 --- a/test/Test/AllTests.purs +++ b/test/Test/AllTests.purs @@ -12,7 +12,7 @@ import Control.MonadPlus (class MonadPlus) import Control.MonadZero (class MonadZero) import Data.Array as Array import Data.Eq (class Eq1, eq1) -import Data.Foldable (class Foldable, foldMap, foldl, sum) +import Data.Foldable (class Foldable, foldMap, foldl, sum, traverse_) import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex) import Data.Function (on) import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) @@ -23,7 +23,7 @@ import Data.List.Lazy.NonEmpty as LNEL import Data.List.NonEmpty as NEL import Data.Maybe (Maybe(..), fromJust, isNothing) import Data.Monoid.Additive (Additive(..)) -import Data.Ord (class Ord1) +import Data.Ord (class Ord1, compare1) import Data.Traversable (class Traversable, traverse) import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) import Data.Tuple (Tuple(..)) @@ -178,7 +178,7 @@ testCommon log "... skipped" -- Todo - make these consistent and also double-check for arrays -- can-empty behavior - -- assertEqual { actual: makeCollection [mul 10, mul 100] <*> l [1, 2, 3], expected: l [10, 20, 30, 100, 200, 300] } + assertEqual { actual: makeCollection [mul 10, mul 100] <*> l [1, 2, 3], expected: l [10, 20, 30, 100, 200, 300] } -- NonEmpty behavior -- assertEqual { actual: makeCollection [mul 10, mul 100] <*> l [1, 2, 3], expected: l [10, 100, 20, 200, 30, 300] } @@ -268,15 +268,29 @@ testCommon assertEqual { actual: mapWithIndex add $ l [0, 1, 2, 3], expected: l [0, 2, 4, 6] } -- Monad - -- Indicates Applicative and Bind, which are already tested + -- Indicates Applicative and Bind, which are already tested above -- Ord -- compare :: a -> a -> Ordering - -- Todo - add tests + log "compare should determine the ordering of two collections" + assertEqual { actual: compare (l [1]) (l [1]), expected: EQ } + assertEqual { actual: compare (l [0]) (l [1]), expected: LT } + assertEqual { actual: compare (l [2]) (l [1]), expected: GT } + assertEqual { actual: compare (l [1]) (l [1, 1]), expected: LT } + assertEqual { actual: compare (l [1, 1]) (l [1]), expected: GT } + assertEqual { actual: compare (l [1, 1]) (l [1, 2]), expected: LT } + assertEqual { actual: compare (l [1, 2]) (l [1, 1]), expected: GT } -- Ord1 -- compare1 :: forall a. Ord a => f a -> f a -> Ordering - -- Todo - add tests + log "compare1 should determine the ordering of two collections" + assertEqual { actual: compare1 (l [1]) (l [1]), expected: EQ } + assertEqual { actual: compare1 (l [0]) (l [1]), expected: LT } + assertEqual { actual: compare1 (l [2]) (l [1]), expected: GT } + assertEqual { actual: compare1 (l [1]) (l [1, 1]), expected: LT } + assertEqual { actual: compare1 (l [1, 1]) (l [1]), expected: GT } + assertEqual { actual: compare1 (l [1, 1]) (l [1, 2]), expected: LT } + assertEqual { actual: compare1 (l [1, 2]) (l [1, 1]), expected: GT } -- Semigroup -- append :: a -> a -> a @@ -321,13 +335,6 @@ testCommon -- =========== Functions =========== - -- Todo - split - -- log "catMaybe should take a collection of Maybe values and throw out Nothings" - -- assertEqual { actual: catMaybes (l [Nothing, Just 2, Nothing, Just 4]), expected: l [2, 4] } - - - assertEqual { actual: l [l [1, 2], l [3, 4]], expected: l [l [1, 2], l [3, 4]] } - log "concat should join a collection of collections" assertEqual { actual: r.concat $ l [l [1, 2], l [3, 4]], expected: l [1, 2, 3, 4] } assertEqual { actual: r.concat $ l [l [1, 2], l [3, 4]], expected: l [1, 2, 3, 4] } @@ -350,13 +357,6 @@ testCommon assertEqual { actual: elemLastIndex 1 $ l [1, 2, 1], expected: Just 2 } assertEqual { actual: elemLastIndex 4 $ l [1, 2, 1], expected: Nothing } - -- Todo split - -- log "filter should remove items that don't match a predicate" - -- assertEqual { actual: filter odd $ range 0 10, expected: l [1, 3, 5, 7, 9] } - - --log "filterM should remove items that don't match a predicate while using a monadic behaviour" - --assertEqual { actual: filterM (Just <<< odd) $ range 0 10, expected: Just $ l [1, 3, 5, 7, 9] } - --assertEqual { actual: filterM (const Nothing) $ rg 0 10, expected: Nothing } log "findIndex should return the index of an item that a predicate returns true for in a collection" assertEqual { actual: findIndex (_ /= 1) $ l [1, 2, 1], expected: Just 1 } @@ -379,15 +379,6 @@ testCommon assertEqual { actual: l [1, 2, 3] `index` 6, expected: Nothing } assertEqual { actual: l [1, 2, 3] `index` (-1), expected: Nothing } - -- todo split - -- log "insertAt should add an item at the specified index" - -- assertEqual { actual: insertAt 0 1 $ l [2, 3], expected: Just $ l [1, 2, 3] } - -- assertEqual { actual: insertAt 1 1 $ l [2, 3], expected: Just $ l [2, 1, 3] } - -- assertEqual { actual: insertAt 2 1 $ l [2, 3], expected: Just $ l [2, 3, 1] } - - -- log "insertAt should return Nothing if the index is out of range" - -- assertEqual { actual: insertAt 7 8 $ l [1,2,3], expected: Nothing } - log "intersect should return the intersection of two collections" assertEqual { actual: intersect (l [1, 2, 3, 4, 3, 2, 1]) $ l [1, 1, 2, 3], expected: l [1, 2, 3, 3, 2, 1] } @@ -401,14 +392,6 @@ testCommon log "length should be stack-safe" void $ pure $ length bigCollection - -- todo split - -- log "modifyAt should update an item at the specified index" - -- assertEqual { actual: modifyAt 0 (_ + 1) $ l [1, 2, 3], expected: Just $ l [2, 2, 3] } - -- assertEqual { actual: modifyAt 1 (_ + 1) $ l [1, 2, 3], expected: Just $ l [1, 3, 3] } - - -- log "modifyAt should return Nothing if the index is out of range" - -- assertEqual { actual: modifyAt 7 (_ + 1) $ l [1,2,3], expected: Nothing } - log "nubEq should remove duplicate elements from the collection, keeping the first occurence" assertEqual { actual: nubEq (l [1, 2, 2, 3, 4, 1]), expected: l [1, 2, 3, 4] } @@ -430,9 +413,12 @@ testCommon log "snoc should add an item to the end of a collection" assertEqual { actual: l [1, 2, 3] `snoc` 4, expected: l [1, 2, 3, 4] } - -- Todo toUnfoldable - --toUnfoldable :: forall f a. Unfoldable f => c a -> f a - + log "toUnfoldable should convert to any unfoldable collection" + traverse_ (\xs -> assertEqual { actual: toUnfoldable (l xs), expected: xs }) + [ [1] + , [1,2,3] + , [4,0,0,1,25,36,458,5842,23757] + ] log "union should produce the union of two collections" assertEqual { actual: union (l [1, 2, 3]) $ l [2, 3, 4], expected: l [1, 2, 3, 4] } @@ -461,11 +447,8 @@ testCommon -} log "appendFoldable should append a foldable collection to another collection" - -- todo - missing for basic list assertEqual { actual: appendFoldable (l [1, 2, 3]) [4, 5], expected: l [1, 2, 3, 4, 5] } - -- Todo - clean these up - log "insert should add an item at the appropriate place in a sorted list" assertEqual { actual: insert 2 $ l [1, 1, 3], expected: l [1, 1, 2, 3] } assertEqual { actual: insert 4 $ l [1, 2, 3], expected: l [1, 2, 3, 4] } @@ -475,9 +458,6 @@ testCommon assertEqual { actual: insertBy (flip compare) 4 $ l [1, 2, 3], expected: l [4, 1, 2, 3] } assertEqual { actual: insertBy (flip compare) 0 $ l [1, 2, 3], expected: l [1, 2, 3, 0] } - -- nub :: forall a. Ord a => c a -> c a - -- nubBy :: forall a. (a -> a -> Ordering) -> c a -> c a - log "nub should remove duplicate elements from a collection, keeping the first occurrence" assertEqual { actual: nub (l [1, 2, 2, 3, 4, 1]), expected: l [1, 2, 3, 4] } @@ -486,8 +466,6 @@ testCommon -- some :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) -- someRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) - -- sort :: forall a. Ord a => c a -> c a - -- sortBy :: forall a. (a -> a -> Ordering) -> c a -> c a log "sort should reorder a collection into ascending order based on the result of compare" assertEqual { actual: sort (l [1, 3, 2, 5, 6, 4]), expected: l [1, 2, 3, 4, 5, 6] } @@ -503,17 +481,25 @@ testCommon assertEqual { actual: transpose (l [l [10, 11], l [20], l [30, 31, 32]]) , expected: l [l [10, 20, 30], l [11, 31], l [32]] } +-- Todo - question: +{- +Should we have a specialized replicate, or just +reuse the one provided by Unfoldable? +-- If reusing from unfoldable, do we need to test here? +-} - {- -- replicate :: forall a. Int -> a -> c a + -- log "replicate should produce an list containing an item a specified number of times" + -- assertEqual { actual: replicate 3 5, expected: l [5, 5, 5] } + -- assert $ replicate 1 "foo" == l ["foo"] + -- assert $ replicate 0 "foo" == l [] + -- assert $ replicate (-1) "foo" == l [] + + {- log "unfoldable replicate should be stack-safe" + -- even for strict lists? Possibly high memory consumption void $ pure $ length $ replicate 100000 1 - log "replicate should produce an list containing an item a specified number of times" - assert $ replicate 3 true == l [true, true, true] - assert $ replicate 1 "foo" == l ["foo"] - assert $ replicate 0 "foo" == l [] - assert $ replicate (-1) "foo" == l [] log "replicateA should perform the monadic action the correct number of times" assert $ replicateA 3 (Just 1) == Just (l [1, 1, 1]) @@ -537,6 +523,9 @@ testCommonDiffEmptiability :: forall c cInverse canEmpty nonEmpty cPattern. Eq (c (nonEmpty Int)) => Eq (canEmpty Int) => Eq (c (c Int)) => + Show (c (nonEmpty Int)) => + Show (canEmpty Int) => + Show (c (c Int)) => SkipBroken -> CommonDiffEmptiability c cInverse canEmpty nonEmpty cPattern -> Effect Unit @@ -589,30 +578,32 @@ testCommonDiffEmptiability skip printTestType "Common (where signatures differ based on emptiability)" - --catMaybes :: forall a. c (Maybe a) -> c a - -- todo - - - -- temporary for troubleshooting - assert $ l [l [1, 2], l [3, 4]] == l [l [1, 2], l [3, 4]] + log "catMaybes should take a collection of Maybe values and remove the Nothings" + assertEqual { actual: catMaybes (l [Nothing, Just 2, Nothing, Just 4]), expected: cel [2, 4] } log "drop should remove the specified number of items from the front of an list" - assert $ (drop 1 (l [1, 2, 3])) == cel [2, 3] - assert $ (drop (-1) (l [1, 2, 3])) == cel [1, 2, 3] + assertEqual { actual: (drop 1 (l [1, 2, 3])), expected: cel [2, 3] } + assertEqual { actual: (drop (-1) (l [1, 2, 3])), expected: cel [1, 2, 3] } log "dropWhile should remove all values that match a predicate from the front of an list" - assert $ (dropWhile (_ /= 1) (l [1, 2, 3])) == cel [1, 2, 3] - assert $ (dropWhile (_ /= 2) (l [1, 2, 3])) == cel [2, 3] + assertEqual { actual: (dropWhile (_ /= 1) (l [1, 2, 3])), expected: cel [1, 2, 3] } + assertEqual { actual: (dropWhile (_ /= 2) (l [1, 2, 3])), expected: cel [2, 3] } --assert $ (dropWhile (_ /= 1) nil) == nil - --filter :: forall a. (a -> Boolean) -> c a -> c a - -- todo + -- Surprised this does not work with $ + -- let l10 = l $ Array.range 0 10 + let l10 = l (Array.range 0 10) + + log "filter should remove items that don't match a predicate" + assertEqual { actual: filter odd l10, expected: cel [1, 3, 5, 7, 9] } + + log "filterM should remove items that don't match a predicate while using a monadic behaviour" + assertEqual { actual: filterM (Just <<< odd) l10, expected: Just $ cel [1, 3, 5, 7, 9] } + assertEqual { actual: filterM (const Nothing) l10, expected: Nothing } - --filterM :: forall m a. Monad m => (a -> m Boolean) -> c a -> m (c a) - -- todo log "group should group consecutive equal elements into lists" - assert $ group (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1], nel [2, 2], nel [3, 3, 3], nel [1]] + assertEqual { actual: group (l [1, 2, 2, 3, 3, 3, 1]), expected: l [nel [1], nel [2, 2], nel [3, 3, 3], nel [1]] } log "groupAll should group equal elements into lists" assertSkip [SkipBrokenLazyCanEmpty] @@ -620,11 +611,11 @@ testCommonDiffEmptiability skip --assert $ groupAll (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1, 1], nel [2, 2], nel [3, 3, 3]] log "groupBy should group consecutive equal elements into lists based on an equivalence relation" - assert $ groupBy (eq `on` (_ `mod` 10)) (l [1, 2, 12, 3, 13, 23, 11]) == l [nel [1], nel [2, 12], nel [3, 13, 23], nel [11]] + assertEqual { actual: groupBy (eq `on` (_ `mod` 10)) (l [1, 2, 12, 3, 13, 23, 11]), expected: l [nel [1], nel [2, 12], nel [3, 13, 23], nel [11]] } -- todo - wait for this to be reworked -- log "groupAllBy should group equal elements into lists based on an comparison function" - --assert $ groupAllBy (compare `on` mod 10) (l [1, 2, 12, 3, 13, 23, 11]) == l [nel [1, 11], nel [2, 12], nel [3, 13, 23]] + --assertEqual { actual: groupAllBy (compare `on` mod 10) (l [1, 2, 12, 3, 13, 23, 11]), expected: l [nel [1, 11], nel [2, 12], nel [3, 13, 23]] } log "mapMaybe should transform every item in an list, throwing out Nothing values" assert $ mapMaybe (\x -> if x /= 0 then Just x else Nothing) (l [0, 1, 0, 0, 2, 3]) == cel [1, 2, 3] @@ -811,6 +802,9 @@ testOnlyNonEmpty , fromList , toList + + -- ? toUnfoldable1? + } = do let l = makeCollection @@ -914,9 +908,24 @@ testOnlyStrict printTestType "Only Strict" + -- log "insertAt should add an item at the specified index" + -- assertEqual { actual: insertAt 0 1 $ l [2, 3], expected: Just $ l [1, 2, 3] } + -- assertEqual { actual: insertAt 1 1 $ l [2, 3], expected: Just $ l [2, 1, 3] } + -- assertEqual { actual: insertAt 2 1 $ l [2, 3], expected: Just $ l [2, 3, 1] } + + -- log "insertAt should return Nothing if the index is out of range" + -- assertEqual { actual: insertAt 7 8 $ l [1,2,3], expected: Nothing } + -- todo insertAt test -- missing from original test suite + -- log "modifyAt should update an item at the specified index" + -- assertEqual { actual: modifyAt 0 (_ + 1) $ l [1, 2, 3], expected: Just $ l [2, 2, 3] } + -- assertEqual { actual: modifyAt 1 (_ + 1) $ l [1, 2, 3], expected: Just $ l [1, 3, 3] } + + -- log "modifyAt should return Nothing if the index is out of range" + -- assertEqual { actual: modifyAt 7 (_ + 1) $ l [1,2,3], expected: Nothing } + -- todo modifyAt test -- missing from original test suite diff --git a/test/Test/UpdatedTests.purs b/test/Test/UpdatedTests.purs index ad9ed0a..5e0b60b 100644 --- a/test/Test/UpdatedTests.purs +++ b/test/Test/UpdatedTests.purs @@ -27,8 +27,8 @@ rebase updatedTests :: Effect Unit updatedTests = do testBasicList - testNonEmptyList - testLazyList + -- testNonEmptyList + -- testLazyList --testLazyNonEmptyList -- Lots of stuff to fix here -- Just using original ZipList tests From 51356f23eded792a0e63e2c6086e4513c71e5acd Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Tue, 12 Jan 2021 15:31:10 -0800 Subject: [PATCH 13/18] Revise groupAllBy to just use an Ordering function --- CHANGELOG.md | 3 +++ src/Data/List.purs | 15 +++++++-------- src/Data/List/NonEmpty.purs | 2 +- test/Test/Data/List.purs | 12 ++++++++---- test/Test/Data/List/NonEmpty.purs | 8 ++++---- 5 files changed, 23 insertions(+), 17 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 553e776..9150925 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,9 @@ Notable changes to this project are documented in this file. The format is based ## [Unreleased] Breaking changes: +- Rename `scanrLazy` to `scanlLazy` and fix parameter ordering (#161) +- Rename `group'` to `groupAll` (#182) +- Change `Alt ZipList` to satisfy distributivity (#150) New features: diff --git a/src/Data/List.purs b/src/Data/List.purs index 75d4617..39ee182 100644 --- a/src/Data/List.purs +++ b/src/Data/List.purs @@ -655,17 +655,16 @@ groupBy _ Nil = Nil groupBy eq (x : xs) = case span (eq x) xs of { init: ys, rest: zs } -> NEL.NonEmptyList (x :| ys) : groupBy eq zs --- | Group equal elements of a list into lists, using the specified --- | equivalence relation to determine equality. --- | --- | For example, +-- | Sort, then group equal elements of a list into lists, using the provided comparison function. -- | -- | ```purescript --- | groupAllBy (\a b -> odd a && odd b) (1 : 3 : 2 : 4 : 3 : 3 : Nil) == --- | (NonEmptyList (NonEmpty 1 Nil)) : (NonEmptyList (NonEmpty 2 Nil)) : (NonEmptyList (NonEmpty 3 (3 : 3 : Nil))) : (NonEmptyList (NonEmpty 4 Nil)) : Nil +-- | groupAllBy (compare `on` (_ `div` 10)) (32 : 31 : 21 : 22 : 11 : 33 : Nil) == +-- | NonEmptyList (11 :| Nil) : NonEmptyList (21 :| 22 : Nil) : NonEmptyList (32 :| 31 : 33) : Nil -- | ``` -groupAllBy :: forall a. Ord a => (a -> a -> Boolean) -> List a -> List (NEL.NonEmptyList a) -groupAllBy p = groupBy p <<< sort +-- | +-- | Running time: `O(n log n)` +groupAllBy :: forall a. (a -> a -> Ordering) -> List a -> List (NEL.NonEmptyList a) +groupAllBy p = groupBy (\x y -> p x y == EQ) <<< sortBy p -- | Returns a lists of elements which do and do not satisfy a predicate. -- | diff --git a/src/Data/List/NonEmpty.purs b/src/Data/List/NonEmpty.purs index 628d5ca..ba5e1cb 100644 --- a/src/Data/List/NonEmpty.purs +++ b/src/Data/List/NonEmpty.purs @@ -340,7 +340,7 @@ group' = groupAll groupBy :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList (NonEmptyList a) groupBy = wrappedOperation "groupBy" <<< L.groupBy -groupAllBy :: forall a. Ord a => (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList (NonEmptyList a) +groupAllBy :: forall a. (a -> a -> Ordering) -> NonEmptyList a -> NonEmptyList (NonEmptyList a) groupAllBy = wrappedOperation "groupAllBy" <<< L.groupAllBy partition :: forall a. (a -> Boolean) -> NonEmptyList a -> { yes :: L.List a, no :: L.List a } diff --git a/test/Test/Data/List.purs b/test/Test/Data/List.purs index 5ac2db8..753d451 100644 --- a/test/Test/Data/List.purs +++ b/test/Test/Data/List.purs @@ -3,7 +3,7 @@ module Test.Data.List (testList) where import Prelude import Data.Array as Array -import Data.Foldable (foldMap, foldl) +import Data.Foldable (class Foldable, foldMap, foldl) import Data.FoldableWithIndex (foldMapWithIndex, foldlWithIndex, foldrWithIndex) import Data.Function (on) import Data.List (List(..), Pattern(..), alterAt, catMaybes, concat, concatMap, delete, deleteAt, deleteBy, drop, dropEnd, dropWhile, elemIndex, elemLastIndex, filter, filterM, findIndex, findLastIndex, foldM, fromFoldable, group, groupAll, groupAllBy, groupBy, head, init, insert, insertAt, insertBy, intersect, intersectBy, last, length, mapMaybe, mapWithIndex, modifyAt, nub, nubBy, nubByEq, nubEq, null, partition, range, reverse, singleton, snoc, sort, sortBy, span, stripPrefix, tail, take, takeEnd, takeWhile, transpose, uncons, union, unionBy, unsnoc, unzip, updateAt, zip, zipWith, zipWithA, (!!), (..), (:), (\\)) @@ -23,7 +23,11 @@ import Test.Assert (assert) testList :: Effect Unit testList = do - let l = fromFoldable + let + l = fromFoldable + + nel :: forall f a. Foldable f => a -> f a -> NEL.NonEmptyList a + nel x xs = NEL.NonEmptyList $ x :| fromFoldable xs log "strip prefix" assert $ stripPrefix (Pattern (1:Nil)) (1:2:Nil) == Just (2:Nil) @@ -275,8 +279,8 @@ testList = do log "groupBy should group consecutive equal elements into lists based on an equivalence relation" assert $ groupBy (\x y -> odd x && odd y) (l [1, 1, 2, 2, 3, 3]) == l [NEL.NonEmptyList (1 :| l [1]), NEL.singleton 2, NEL.singleton 2, NEL.NonEmptyList (3 :| l [3])] - log "groupAllBy should group equal elements into lists based on an equivalence relation" - assert $ groupAllBy (\x y -> odd x && odd y) (l [1, 3, 2, 4, 3, 3]) == l [NEL.singleton 1, NEL.singleton 2, NEL.NonEmptyList (3 :| l [3, 3]), NEL.singleton 4] + log "groupAllBy should sort then group equal elements into lists based on a comparison function" + assert $ groupAllBy (compare `on` (_ `div` 10)) (l [32, 31, 21, 22, 11, 33]) == l [nel 11 [], nel 21 [22], nel 32 [31, 33]] log "partition should separate a list into a tuple of lists that do and do not satisfy a predicate" let partitioned = partition (_ > 2) (l [1, 5, 3, 2, 4]) diff --git a/test/Test/Data/List/NonEmpty.purs b/test/Test/Data/List/NonEmpty.purs index b12380a..3a342f9 100644 --- a/test/Test/Data/List/NonEmpty.purs +++ b/test/Test/Data/List/NonEmpty.purs @@ -21,9 +21,9 @@ import Test.Assert (assert) testNonEmptyList :: Effect Unit testNonEmptyList = do let - nel :: ∀ f a. Foldable f => a -> f a -> NEL.NonEmptyList a + nel :: forall f a. Foldable f => a -> f a -> NEL.NonEmptyList a nel x xs = NEL.NonEmptyList $ x :| L.fromFoldable xs - l :: ∀ f a. Foldable f => f a -> L.List a + l :: forall f a. Foldable f => f a -> L.List a l = L.fromFoldable log "singleton should construct a non-empty list with a single value" @@ -176,8 +176,8 @@ testNonEmptyList = do log "groupBy should group consecutive equal elements into lists based on an equivalence relation" assert $ NEL.groupBy (\x y -> odd x && odd y) (nel 1 [1, 2, 2, 3, 3]) == nel (nel 1 [1]) [nel 2 [], nel 2 [], nel 3 [3]] - log "groupAllBy should group equal elements into lists based on an equivalence relation" - assert $ NEL.groupAllBy (\x y -> odd x && odd y) (nel 1 [3, 2, 4, 3, 3]) == nel (nel 1 []) [nel 2 [], nel 3 [3, 3], nel 4 []] + log "groupAllBy should sort then group equal elements into lists based on a comparison function" + assert $ NEL.groupAllBy (compare `on` (_ `div` 10)) (nel 32 [31, 21, 22, 11, 33]) == nel (nel 11 []) [nel 21 [22], nel 32 [31, 33]] log "partition should separate a list into a tuple of lists that do and do not satisfy a predicate" let partitioned = NEL.partition (_ > 2) (nel 1 [5, 3, 2, 4]) From f3d4305fbe6609a3d69f5ae8b6d37a945581b6eb Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Mon, 3 May 2021 08:12:52 -0700 Subject: [PATCH 14/18] builds --- src/Data/List/Lazy.purs | 2 +- src/Data/List/Lazy/NonEmpty.purs | 2 +- test/Test/API.purs | 6 ++---- 3 files changed, 4 insertions(+), 6 deletions(-) diff --git a/src/Data/List/Lazy.purs b/src/Data/List/Lazy.purs index fe3dc4a..8400e1c 100644 --- a/src/Data/List/Lazy.purs +++ b/src/Data/List/Lazy.purs @@ -147,7 +147,7 @@ cons' :: forall a. a -> NEL.NonEmptyList a -> List a cons' _ _ = unsafeCrashWith "todo cons' for Lazy List" dropEnd :: forall a. Int -> List a -> List a dropEnd _ _ = unsafeCrashWith "todo dropEnd for Lazy List" -groupAllBy :: forall a. Ord a => (a -> a -> Boolean) -> List a -> List (NEL.NonEmptyList a) +groupAllBy :: forall a. (a -> a -> Ordering) -> List a -> List (NEL.NonEmptyList a) groupAllBy _ _ = unsafeCrashWith "todo groupAllBy for Lazy List" snoc' :: forall a. NEL.NonEmptyList a -> a -> List a snoc' _ _ = unsafeCrashWith "todo snoc' for Lazy List" diff --git a/src/Data/List/Lazy/NonEmpty.purs b/src/Data/List/Lazy/NonEmpty.purs index ce2ca21..fac5984 100644 --- a/src/Data/List/Lazy/NonEmpty.purs +++ b/src/Data/List/Lazy/NonEmpty.purs @@ -256,7 +256,7 @@ difference :: forall a. Eq a => NonEmptyList a -> NonEmptyList a -> L.List a difference _ _ = unsafeCrashWith "todo difference for LazyNonEmptyList" dropEnd :: forall a. Int -> NonEmptyList a -> L.List a dropEnd _ _ = unsafeCrashWith "todo dropEnd for LazyNonEmptyList" -groupAllBy :: forall a. Ord a => (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList (NonEmptyList a) +groupAllBy :: forall a. (a -> a -> Ordering) -> NonEmptyList a -> NonEmptyList (NonEmptyList a) groupAllBy _ _ = unsafeCrashWith "todo groupAllBy for LazyNonEmptyList" slice :: Int -> Int -> NonEmptyList ~> L.List slice _ _ = unsafeCrashWith "todo slice for LazyNonEmptyList" diff --git a/test/Test/API.purs b/test/Test/API.purs index 0eaa04a..a8ce732 100644 --- a/test/Test/API.purs +++ b/test/Test/API.purs @@ -44,7 +44,7 @@ type Common c = , insertBy :: forall a. (a -> a -> Ordering) -> a -> c a -> c a , nub :: forall a. Ord a => c a -> c a , nubBy :: forall a. (a -> a -> Ordering) -> c a -> c a - , replicate :: forall a. Int -> a -> c a + -- , replicate :: forall a. Int -> a -> c a , some :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) , someRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) , sort :: forall a. Ord a => c a -> c a @@ -78,9 +78,7 @@ type CommonDiffEmptiability c cInverse canEmpty nonEmpty cPattern = , deleteBy :: forall a. (a -> a -> Boolean) -> a -> c a -> canEmpty a , difference :: forall a. Eq a => c a -> c a -> canEmpty a , dropEnd :: forall a. Int -> c a -> canEmpty a - -- There's a pending PR to update this signature - -- groupAllBy :: forall a. (a -> a -> Ordering) -> c a -> c (nonEmpty a) - , groupAllBy :: forall a. Ord a => (a -> a -> Boolean) -> c a -> c (nonEmpty a) + , groupAllBy :: forall a. (a -> a -> Ordering) -> c a -> c (nonEmpty a) , pattern :: forall a. c a -> cPattern a , slice :: Int -> Int -> c ~> canEmpty , snoc' :: forall a. cInverse a -> a -> c a From f34b041a11f5b9a3cc7d375916c0476f18a6a457 Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Wed, 19 May 2021 16:52:23 -0700 Subject: [PATCH 15/18] more patching, about to implement remaining tests --- src/Data/List/Lazy.purs | 10 ++ src/Data/List/Lazy/NonEmpty.purs | 10 ++ test/Test/API.purs | 41 +++++++- test/Test/AllTests.purs | 146 +++++++++++++++++++-------- test/Test/Args/LazyList.purs | 12 ++- test/Test/Args/LazyNonEmptyList.purs | 11 +- test/Test/Args/List.purs | 8 +- test/Test/Args/NonEmptyList.purs | 8 +- test/Test/UpdatedTests.purs | 9 +- 9 files changed, 198 insertions(+), 57 deletions(-) diff --git a/src/Data/List/Lazy.purs b/src/Data/List/Lazy.purs index 8400e1c..da89428 100644 --- a/src/Data/List/Lazy.purs +++ b/src/Data/List/Lazy.purs @@ -109,6 +109,9 @@ module Data.List.Lazy , snoc' , manyRec + , replicate1 + , replicate1M + ) where import Prelude @@ -155,6 +158,13 @@ snoc' _ _ = unsafeCrashWith "todo snoc' for Lazy List" manyRec :: forall f a. MonadRec f => Alternative f => f a -> f (List a) manyRec _ = unsafeCrashWith "todo manyRec for Lazy List" +-- Specialized from Unfoldable1's replicate1 / replicate1A +replicate1 :: forall a. Int -> a -> List a +replicate1 _ _ = unsafeCrashWith "todo replicate1 for Lazy List" + +replicate1M :: forall m a. Monad m => Int -> m a -> m (List a) +replicate1M _ _ = unsafeCrashWith "todo replicate1M for Lazy List" + -- | Convert a list into any unfoldable structure. -- | -- | Running time: `O(n)` diff --git a/src/Data/List/Lazy/NonEmpty.purs b/src/Data/List/Lazy/NonEmpty.purs index fac5984..9525892 100644 --- a/src/Data/List/Lazy/NonEmpty.purs +++ b/src/Data/List/Lazy/NonEmpty.purs @@ -84,6 +84,9 @@ module Data.List.Lazy.NonEmpty , foldrLazy , scanlLazy + , replicate1 + , replicate1M + ) where import Prelude @@ -276,6 +279,13 @@ foldrLazy _ _ _ = unsafeCrashWith "todo foldrLazy for LazyNonEmptyList" scanlLazy :: forall a b. (b -> a -> b) -> b -> NonEmptyList a -> NonEmptyList b scanlLazy _ _ _ = unsafeCrashWith "todo scanlLazy for LazyNonEmptyList" +-- Specialized from Unfoldable1's replicate1 / replicate1A +replicate1 :: forall a. Int -> a -> NonEmptyList a +replicate1 _ _ = unsafeCrashWith "todo replicate1 for LazyNonEmptyList" + +replicate1M :: forall m a. Monad m => Int -> m a -> m (NonEmptyList a) +replicate1M _ _ = unsafeCrashWith "todo replicate1M for LazyNonEmptyList" + ----------- toUnfoldable :: forall f. Unfoldable f => NonEmptyList ~> f diff --git a/test/Test/API.purs b/test/Test/API.purs index a8ce732..5e97769 100644 --- a/test/Test/API.purs +++ b/test/Test/API.purs @@ -153,8 +153,45 @@ type OnlyLazy c = , cycle :: forall a. c a -> c a , foldrLazy :: forall a b. Lazy b => (a -> b -> b) -> b -> c a -> b , scanlLazy :: forall a b. (b -> a -> b) -> b -> c a -> c b + + -- Specialized from Unfoldable1's replicate1 / replicate1A + , replicate1 :: forall a. Int -> a -> c a + , replicate1M :: forall m a. Monad m => Int -> m a -> m (c a) + } + + +-- Non Overlapping APIs + +type OnlyStrictCanEmpty :: forall k. (k -> Type) -> Type +type OnlyStrictCanEmpty c = + { + -- Same names, but different APIs + deleteAt :: forall a. Int -> c a -> Maybe (c a) + } + +type OnlyStrictNonEmpty :: forall k. (k -> Type) -> (k -> Type) -> Type +type OnlyStrictNonEmpty c canEmpty = + { + -- Same names, but different APIs + deleteAt :: forall a. Int -> c a -> Maybe (canEmpty a) } +-- Todo - investigate why kind signature is only recommended when +-- records contain only a single field + +type OnlyLazyCanEmpty c = + { + -- Same names, but different APIs + deleteAt :: forall a. Int -> c a -> c a + -- Unique functions + -- Specialized from Unfoldable's replicate / replicateA + , replicate :: forall a. Int -> a -> c a + , replicateM :: forall m a. Monad m => Int -> m a -> m (c a) + } --- Todo - no overlap --- Or may not be necessary to define here +type OnlyLazyNonEmpty :: forall k. (k -> Type) -> (k -> Type) -> Type +type OnlyLazyNonEmpty c canEmpty = + { + -- Same names, but different APIs + deleteAt :: forall a. Int -> c a -> canEmpty a + } \ No newline at end of file diff --git a/test/Test/AllTests.purs b/test/Test/AllTests.purs index 2495f52..615498b 100644 --- a/test/Test/AllTests.purs +++ b/test/Test/AllTests.purs @@ -27,16 +27,17 @@ import Data.Ord (class Ord1, compare1) import Data.Traversable (class Traversable, traverse) import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) import Data.Tuple (Tuple(..)) -import Data.Unfoldable (class Unfoldable, unfoldr) +import Data.Unfoldable (class Unfoldable, replicate1A, unfoldr) import Data.Unfoldable1 (class Unfoldable1, unfoldr1) +import Data.Unfoldable1 as Unfoldable1 import Effect (Effect) import Effect.Console (log) import Partial.Unsafe (unsafePartial) -import Test.API (Common, CommonDiffEmptiability, OnlyCanEmpty, OnlyLazy, OnlyNonEmpty, OnlyStrict) +import Test.API (Common, CommonDiffEmptiability, OnlyCanEmpty, OnlyLazy, OnlyLazyCanEmpty, OnlyNonEmpty, OnlyStrict, OnlyStrictCanEmpty, OnlyStrictNonEmpty, OnlyLazyNonEmpty) import Test.Assert (assert, assertEqual, assertEqual') {- -This is temporarily being used during development. +This "Skip" code is temporarily being used during development. It allows testing while still patching the API. This is passed as an additional argument to testCommon to indicate which collection type is being tested, and @@ -333,8 +334,19 @@ testCommon log "unfoldr1 should maintain order" assertEqual { actual: rg 1 5, expected: unfoldr1 step1 1 } + log "Unfoldable1 replicate1 should be stack-safe" + void $ pure $ r.length $ (Unfoldable1.replicate1 100000 1 :: c Int) + -- =========== Functions =========== + -- These bindings are to suppress warning squiggles covering this entire function. + -- Can remove these and record accessor workaround once this issue is resolved: + -- https://github.com/purescript/purescript/issues/3938 + let + no_warn_unused_concat = concat + no_warn_unused_reverse = reverse + no_warn_unused_unzip = unzip + log "concat should join a collection of collections" assertEqual { actual: r.concat $ l [l [1, 2], l [3, 4]], expected: l [1, 2, 3, 4] } assertEqual { actual: r.concat $ l [l [1, 2], l [3, 4]], expected: l [1, 2, 3, 4] } @@ -464,8 +476,14 @@ testCommon log "nubBy should remove duplicate items from a collection using a supplied predicate" assertEqual { actual: nubBy (compare `on` Array.length) $ l [[1],[2],[3,4]] , expected: l [[1],[3,4]] } + -- some :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) -- someRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) + -- Todo - create tests for these functions + let + todo_some = some + todo_someRec = someRec + log "sort should reorder a collection into ascending order based on the result of compare" assertEqual { actual: sort (l [1, 3, 2, 5, 6, 4]), expected: l [1, 2, 3, 4, 5, 6] } @@ -488,6 +506,8 @@ reuse the one provided by Unfoldable? -- If reusing from unfoldable, do we need to test here? -} +-- only test when specialized + -- replicate :: forall a. Int -> a -> c a -- log "replicate should produce an list containing an item a specified number of times" -- assertEqual { actual: replicate 3 5, expected: l [5, 5, 5] } @@ -501,22 +521,10 @@ reuse the one provided by Unfoldable? void $ pure $ length $ replicate 100000 1 - log "replicateA should perform the monadic action the correct number of times" - assert $ replicateA 3 (Just 1) == Just (l [1, 1, 1]) - assert $ replicateA 1 (Just 1) == Just (l [1]) - assert $ replicateA 0 (Just 1) == Just (l []) - assert $ replicateA (-1) (Just 1) == Just (l []) -} - + -- specialized lazy -- replicateM :: forall m a. Monad m => Int -> m a -> m (c a) - -- some :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) - -- someRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) - -- sort :: forall a. Ord a => c a -> c a - -- sortBy :: forall a. (a -> a -> Ordering) -> c a -> c a - -- transpose :: forall a. c (c a) -> c (c a) - - testCommonDiffEmptiability :: forall c cInverse canEmpty nonEmpty cPattern. @@ -578,6 +586,19 @@ testCommonDiffEmptiability skip printTestType "Common (where signatures differ based on emptiability)" + -- Todo - create tests for these functions + let + todo_stripPrefix = stripPrefix + todo_snoc' = snoc' + todo_slice = slice + todo_pattern = pattern + todo_groupAllBy = groupAllBy + todo_dropEnd = dropEnd + todo_difference = difference + todo_deleteBy = deleteBy + todo_delete = delete + todo_cons' = cons' + log "catMaybes should take a collection of Maybe values and remove the Nothings" assertEqual { actual: catMaybes (l [Nothing, Just 2, Nothing, Just 4]), expected: cel [2, 4] } @@ -656,8 +677,6 @@ testCommonDiffEmptiability skip --assert $ (takeWhile (_ /= 1) nil) == nil - - testOnlyCanEmpty :: forall c nonEmpty. Alternative c => MonadPlus c => @@ -733,6 +752,14 @@ testOnlyCanEmpty -- ======= Functions tests ======== + -- Todo tests for these functions + let + todo_null = null + todo_manyRec = manyRec + todo_many = many + todo_fromFoldable = fromFoldable + + --fromFoldable :: forall f. Foldable f => f ~> c --already extensively checked in common tests @@ -831,6 +858,12 @@ testOnlyNonEmpty assertEqual { actual: r.toList $ l [1, 2, 3], expected: cel [1, 2, 3] } + -- Todo create tests for these functions + let + todo_toList = toList + todo_fromList = fromList + todo_fromFoldable = fromFoldable + -- These are the remaining functions that can't be deduplicated due to use of Maybe log "head should return a the first value" @@ -861,22 +894,39 @@ testOnlyLazy :: forall c. testOnlyLazy { makeCollection + -- Same names, but different APIs (without Maybe) , alterAt , insertAt , modifyAt , updateAt + -- These are only available for Lazy collections , iterate , repeat , cycle , foldrLazy , scanlLazy + + -- Specialized from Unfoldable1's replicate1 / replicate1A + , replicate1 + , replicate1M } = do let l = makeCollection printTestType "Only Lazy" + -- Todo - create tests for these functions + let + todo_alterAt = alterAt + todo_iterate = iterate + todo_repeat = repeat + todo_cycle = cycle + todo_foldrLazy = foldrLazy + todo_scanlLazy = scanlLazy + todo_replicate1 = replicate1 + todo_replicate1M = replicate1M + log "insertAt should add an item at the specified index" assert $ (insertAt 0 1 (l [2, 3])) == (l [1, 2, 3]) assert $ (insertAt 1 1 (l [2, 3])) == (l [2, 1, 3]) @@ -897,10 +947,12 @@ testOnlyStrict :: forall c. testOnlyStrict { makeCollection + -- Same names, but different APIs (with Maybe) , alterAt , insertAt , modifyAt , updateAt + } = do let @@ -908,6 +960,13 @@ testOnlyStrict printTestType "Only Strict" + -- Todo - create tests for these functions + let + todo_alterAt = alterAt + todo_insertAt = insertAt + todo_modifyAt = modifyAt + todo_updateAt = updateAt + -- log "insertAt should add an item at the specified index" -- assertEqual { actual: insertAt 0 1 $ l [2, 3], expected: Just $ l [1, 2, 3] } -- assertEqual { actual: insertAt 1 1 $ l [2, 3], expected: Just $ l [2, 1, 3] } @@ -940,15 +999,14 @@ testOnlyStrict -- Functions that cannot be tested generically. --- Debating whether these should be passed a record defined in the API? - assertSkipAlways :: (_ -> Boolean) -> Effect Unit assertSkipAlways _ = log "...skipped" -testOnlyStrictCanEmpty :: Effect Unit -testOnlyStrictCanEmpty = do + +testOnlyStrictCanEmpty :: OnlyStrictCanEmpty L.List -> Effect Unit +testOnlyStrictCanEmpty { deleteAt } = do let l :: forall f a. Foldable f => f a -> L.List a @@ -959,16 +1017,16 @@ testOnlyStrictCanEmpty = do -- Common function names, but different signatures log "deleteAt should remove an item at the specified index" - assert $ L.deleteAt 0 (l [1, 2, 3]) == Just (l [2, 3]) - assert $ L.deleteAt 1 (l [1, 2, 3]) == Just (l [1, 3]) + assert $ deleteAt 0 (l [1, 2, 3]) == Just (l [2, 3]) + assert $ deleteAt 1 (l [1, 2, 3]) == Just (l [1, 3]) -- Corner Cases -- Unique functions -testOnlyStrictNonEmpty :: Effect Unit -testOnlyStrictNonEmpty = do +testOnlyStrictNonEmpty :: OnlyStrictNonEmpty NEL.NonEmptyList L.List -> Effect Unit +testOnlyStrictNonEmpty { deleteAt } = do let l :: forall f a. Foldable f => f a -> NEL.NonEmptyList a @@ -982,16 +1040,20 @@ testOnlyStrictNonEmpty = do -- Common function names, but different signatures log "deleteAt should remove an item at the specified index" - assertSkipAlways \_ -> NEL.deleteAt 0 (l [1, 2, 3]) == Just (cel [2, 3]) - assertSkipAlways \_ -> NEL.deleteAt 1 (l [1, 2, 3]) == Just (cel [1, 3]) + assertSkipAlways \_ -> deleteAt 0 (l [1, 2, 3]) == Just (cel [2, 3]) + assertSkipAlways \_ -> deleteAt 1 (l [1, 2, 3]) == Just (cel [1, 3]) -- Corner Cases -- Unique functions -testOnlyLazyCanEmpty :: Effect Unit -testOnlyLazyCanEmpty = do +testOnlyLazyCanEmpty :: OnlyLazyCanEmpty LL.List -> Effect Unit +testOnlyLazyCanEmpty + { deleteAt + , replicate + , replicateM + } = do let l :: forall f a. Foldable f => f a -> LL.List a @@ -1002,19 +1064,22 @@ testOnlyLazyCanEmpty = do -- Common function names, but different signatures log "deleteAt should remove an item at the specified index" - assert $ LL.deleteAt 0 (l [1, 2, 3]) == l [2, 3] - assert $ LL.deleteAt 1 (l [1, 2, 3]) == l [1, 3] + assert $ deleteAt 0 (l [1, 2, 3]) == l [2, 3] + assert $ deleteAt 1 (l [1, 2, 3]) == l [1, 3] -- Corner Cases -- Unique functions - -- replicate (specialized from Unfoldable's replicate) - -- replicateM (specialized from Unfoldable's replicateA) + -- Todo create tests for these functions + let + todo_replicate = replicate + todo_replicateM = replicateM + pure unit -testOnlyLazyNonEmpty :: Effect Unit -testOnlyLazyNonEmpty = do +testOnlyLazyNonEmpty :: OnlyLazyNonEmpty LNEL.NonEmptyList LL.List -> Effect Unit +testOnlyLazyNonEmpty { deleteAt } = do let l :: forall f a. Foldable f => f a -> LNEL.NonEmptyList a @@ -1028,14 +1093,9 @@ testOnlyLazyNonEmpty = do -- Common function names, but different signatures log "deleteAt should remove an item at the specified index" - assert $ LNEL.deleteAt 0 (l [1, 2, 3]) == cel [2, 3] - assert $ LNEL.deleteAt 1 (l [1, 2, 3]) == cel [1, 3] + assert $ deleteAt 0 (l [1, 2, 3]) == cel [2, 3] + assert $ deleteAt 1 (l [1, 2, 3]) == cel [1, 3] -- Corner Cases -- Unique functions - - -- replicate1 (specialized from Unfoldable1's replicate1) - -- replicate1M (specialized from Unfoldable1's replicate1A) - - diff --git a/test/Test/Args/LazyList.purs b/test/Test/Args/LazyList.purs index 7187e4e..b447eef 100644 --- a/test/Test/Args/LazyList.purs +++ b/test/Test/Args/LazyList.purs @@ -7,7 +7,7 @@ import Data.List.Lazy.NonEmpty as NEL import Data.Maybe (fromJust) import Partial.Unsafe (unsafePartial) import Prelude ((<<<)) -import Test.API (Common, CommonDiffEmptiability, OnlyCanEmpty, OnlyLazy) +import Test.API (Common, CommonDiffEmptiability, OnlyCanEmpty, OnlyLazy, OnlyLazyCanEmpty) makeCollection :: forall a f. Foldable f => f a -> List a makeCollection = fromFoldable @@ -125,4 +125,14 @@ onlyLazy = , cycle , foldrLazy , scanlLazy + + , replicate1 + , replicate1M + } + +onlyLazyCanEmpty :: OnlyLazyCanEmpty List +onlyLazyCanEmpty = + { deleteAt + , replicate + , replicateM } \ No newline at end of file diff --git a/test/Test/Args/LazyNonEmptyList.purs b/test/Test/Args/LazyNonEmptyList.purs index 99f2e20..59c5e4f 100644 --- a/test/Test/Args/LazyNonEmptyList.purs +++ b/test/Test/Args/LazyNonEmptyList.purs @@ -7,7 +7,7 @@ import Data.List.Lazy as L import Data.Maybe (fromJust) import Partial.Unsafe (unsafePartial) import Prelude ((<<<)) -import Test.API (Common, CommonDiffEmptiability, OnlyNonEmpty, OnlyLazy) +import Test.API (Common, CommonDiffEmptiability, OnlyLazy, OnlyNonEmpty, OnlyLazyNonEmpty) makeCollection :: forall a f. Foldable f => f a -> NonEmptyList a makeCollection = unsafePartial fromJust <<< fromFoldable @@ -123,4 +123,11 @@ onlyLazy = , cycle , foldrLazy , scanlLazy - } \ No newline at end of file + + , replicate1 + , replicate1M + } + +onlyLazyNonEmpty :: OnlyLazyNonEmpty NonEmptyList L.List +onlyLazyNonEmpty = + { deleteAt } \ No newline at end of file diff --git a/test/Test/Args/List.purs b/test/Test/Args/List.purs index d1fcffe..8958310 100644 --- a/test/Test/Args/List.purs +++ b/test/Test/Args/List.purs @@ -7,7 +7,7 @@ import Data.List.NonEmpty as NEL import Data.Maybe (fromJust) import Partial.Unsafe (unsafePartial) import Prelude ((<<<)) -import Test.API (Common, CommonDiffEmptiability, OnlyCanEmpty, OnlyStrict) +import Test.API (Common, CommonDiffEmptiability, OnlyCanEmpty, OnlyStrict, OnlyStrictCanEmpty) makeCollection :: forall a f. Foldable f => f a -> List a makeCollection = fromFoldable @@ -118,4 +118,8 @@ onlyStrict = , insertAt , modifyAt , updateAt - } \ No newline at end of file + } + +onlyStrictCanEmpty :: OnlyStrictCanEmpty List +onlyStrictCanEmpty = + { deleteAt } \ No newline at end of file diff --git a/test/Test/Args/NonEmptyList.purs b/test/Test/Args/NonEmptyList.purs index ca4dfb3..0c426e5 100644 --- a/test/Test/Args/NonEmptyList.purs +++ b/test/Test/Args/NonEmptyList.purs @@ -7,7 +7,7 @@ import Data.List as L import Data.Maybe (fromJust) import Partial.Unsafe (unsafePartial) import Prelude ((<<<)) -import Test.API (Common, CommonDiffEmptiability, OnlyNonEmpty, OnlyStrict) +import Test.API (Common, CommonDiffEmptiability, OnlyNonEmpty, OnlyStrict, OnlyStrictNonEmpty) makeCollection :: forall a f. Foldable f => f a -> NonEmptyList a makeCollection = unsafePartial fromJust <<< fromFoldable @@ -117,4 +117,8 @@ onlyStrict = , insertAt , modifyAt , updateAt - } \ No newline at end of file + } + +onlyStrictNonEmpty :: OnlyStrictNonEmpty NonEmptyList L.List +onlyStrictNonEmpty = + { deleteAt } \ No newline at end of file diff --git a/test/Test/UpdatedTests.purs b/test/Test/UpdatedTests.purs index 5e0b60b..abef5ba 100644 --- a/test/Test/UpdatedTests.purs +++ b/test/Test/UpdatedTests.purs @@ -53,7 +53,7 @@ testBasicList = do T.testCommonDiffEmptiability T.RunAll LA.commonDiffEmptiability T.testOnlyCanEmpty LA.onlyCanEmpty T.testOnlyStrict LA.onlyStrict - T.testOnlyStrictCanEmpty + T.testOnlyStrictCanEmpty LA.onlyStrictCanEmpty testNonEmptyList :: Effect Unit testNonEmptyList = do @@ -64,7 +64,7 @@ testNonEmptyList = do T.testCommonDiffEmptiability T.SkipBrokenStrictNonEmpty NELA.commonDiffEmptiability T.testOnlyNonEmpty NELA.onlyNonEmpty T.testOnlyStrict NELA.onlyStrict - T.testOnlyStrictNonEmpty + T.testOnlyStrictNonEmpty NELA.onlyStrictNonEmpty testLazyList :: Effect Unit testLazyList = do @@ -73,8 +73,7 @@ testLazyList = do T.testCommonDiffEmptiability T.SkipBrokenLazyCanEmpty LLA.commonDiffEmptiability T.testOnlyCanEmpty LLA.onlyCanEmpty T.testOnlyLazy LLA.onlyLazy - T.testOnlyStrictCanEmpty - T.testOnlyLazyCanEmpty + T.testOnlyLazyCanEmpty LLA.onlyLazyCanEmpty testLazyNonEmptyList :: Effect Unit @@ -88,7 +87,7 @@ testLazyNonEmptyList = do T.testCommonDiffEmptiability T.RunAll LNELA.commonDiffEmptiability T.testOnlyNonEmpty LNELA.onlyNonEmpty T.testOnlyLazy LNELA.onlyLazy - T.testOnlyLazyNonEmpty + T.testOnlyLazyNonEmpty LNELA.onlyLazyNonEmpty -- nil is passed instead of a singleton, -- because some of the functions use this From 6bd54d15b0037649c12d19066a3ab4014b628e5f Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Wed, 19 May 2021 19:24:17 -0700 Subject: [PATCH 16/18] about to convert to assertEqual --- test/Test/AllTests.purs | 28 +++++++++++----------------- 1 file changed, 11 insertions(+), 17 deletions(-) diff --git a/test/Test/AllTests.purs b/test/Test/AllTests.purs index 615498b..253776f 100644 --- a/test/Test/AllTests.purs +++ b/test/Test/AllTests.purs @@ -28,6 +28,7 @@ import Data.Traversable (class Traversable, traverse) import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) import Data.Tuple (Tuple(..)) import Data.Unfoldable (class Unfoldable, replicate1A, unfoldr) +import Data.Unfoldable as Unfoldable import Data.Unfoldable1 (class Unfoldable1, unfoldr1) import Data.Unfoldable1 as Unfoldable1 import Effect (Effect) @@ -334,7 +335,7 @@ testCommon log "unfoldr1 should maintain order" assertEqual { actual: rg 1 5, expected: unfoldr1 step1 1 } - log "Unfoldable1 replicate1 should be stack-safe" + log "Unfoldable1's replicate1 should be stack-safe" void $ pure $ r.length $ (Unfoldable1.replicate1 100000 1 :: c Int) -- =========== Functions =========== @@ -499,15 +500,6 @@ testCommon assertEqual { actual: transpose (l [l [10, 11], l [20], l [30, 31, 32]]) , expected: l [l [10, 20, 30], l [11, 31], l [32]] } --- Todo - question: -{- -Should we have a specialized replicate, or just -reuse the one provided by Unfoldable? --- If reusing from unfoldable, do we need to test here? --} - --- only test when specialized - -- replicate :: forall a. Int -> a -> c a -- log "replicate should produce an list containing an item a specified number of times" -- assertEqual { actual: replicate 3 5, expected: l [5, 5, 5] } @@ -523,9 +515,6 @@ reuse the one provided by Unfoldable? -} - -- specialized lazy - -- replicateM :: forall m a. Monad m => Int -> m a -> m (c a) - testCommonDiffEmptiability :: forall c cInverse canEmpty nonEmpty cPattern. Eq (c (nonEmpty Int)) => @@ -687,9 +676,11 @@ testOnlyCanEmpty :: forall c nonEmpty. -- Eq (c Int) => Eq (c (nonEmpty Int)) => + Show (c Int) => + Show (c (nonEmpty Int)) => OnlyCanEmpty c nonEmpty -> Effect Unit testOnlyCanEmpty - { makeCollection + r@{ makeCollection , makeNonEmptyCollection , fromFoldable @@ -745,10 +736,13 @@ testOnlyCanEmpty log "unfoldr should maintain order" let step :: Int -> Maybe (Tuple Int Int) - step 6 = Nothing - step n = Just (Tuple n (n + 1)) - assert $ l [1, 2, 3, 4, 5] == unfoldr step 1 + step n = if n > 5 then Nothing else Just $ Tuple n $ n + 1 + + -- assert $ l [1, 2, 3, 4, 5] == unfoldr step 1 + assertEqual { actual: unfoldr step 1, expected: l [1, 2, 3, 4, 5] } + log "Unfoldable's replicate should be stack-safe" + void $ pure $ r.last $ (Unfoldable.replicate 100000 1 :: c Int) -- ======= Functions tests ======== From 8f944305135d314cb8854da6917d33bd588f44c3 Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Wed, 19 May 2021 19:49:38 -0700 Subject: [PATCH 17/18] converted to assertEqual --- test/Test/AllTests.purs | 114 +++++++++++++++++++++------------------- 1 file changed, 59 insertions(+), 55 deletions(-) diff --git a/test/Test/AllTests.purs b/test/Test/AllTests.purs index 253776f..3a051ab 100644 --- a/test/Test/AllTests.purs +++ b/test/Test/AllTests.purs @@ -55,11 +55,14 @@ data SkipBroken derive instance eqSkipBroken :: Eq SkipBroken -assertSkipHelper :: SkipBroken -> Array SkipBroken -> (_ -> Boolean) -> Effect Unit +type AssertRec a = { actual :: a , expected :: a } + +assertSkipHelper :: forall a. Eq a => Show a => + SkipBroken -> Array SkipBroken -> (Unit -> AssertRec a) -> Effect Unit assertSkipHelper skip arr f = case Array.elem skip arr of true -> log "...skipped" - false -> assert $ f unit + false -> assertEqual $ f unit printCollectionType :: String -> Effect Unit printCollectionType str = do @@ -570,7 +573,7 @@ testCommonDiffEmptiability skip -- nel x = toNonEmpty (makeCollection x) nel = makeNonEmptyCollection - assertSkip :: Array SkipBroken -> (_ -> Boolean) -> Effect Unit + assertSkip :: forall a. Eq a => Show a => Array SkipBroken -> (_ -> AssertRec a) -> Effect Unit assertSkip = assertSkipHelper skip printTestType "Common (where signatures differ based on emptiability)" @@ -617,7 +620,7 @@ testCommonDiffEmptiability skip log "groupAll should group equal elements into lists" assertSkip [SkipBrokenLazyCanEmpty] - \_ -> groupAll (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1, 1], nel [2, 2], nel [3, 3, 3]] + \_ -> { actual: groupAll (l [1, 2, 2, 3, 3, 3, 1]), expected: l [nel [1, 1], nel [2, 2], nel [3, 3, 3]] } --assert $ groupAll (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1, 1], nel [2, 2], nel [3, 3, 3]] log "groupBy should group consecutive equal elements into lists based on an equivalence relation" @@ -628,32 +631,32 @@ testCommonDiffEmptiability skip --assertEqual { actual: groupAllBy (compare `on` mod 10) (l [1, 2, 12, 3, 13, 23, 11]), expected: l [nel [1, 11], nel [2, 12], nel [3, 13, 23]] } log "mapMaybe should transform every item in an list, throwing out Nothing values" - assert $ mapMaybe (\x -> if x /= 0 then Just x else Nothing) (l [0, 1, 0, 0, 2, 3]) == cel [1, 2, 3] + assertEqual { actual: mapMaybe (\x -> if x /= 0 then Just x else Nothing) (l [0, 1, 0, 0, 2, 3]), expected: cel [1, 2, 3] } log "partition should separate a list into a tuple of lists that do and do not satisfy a predicate" let partitioned = partition (_ > 2) (l [1, 5, 3, 2, 4]) - assert $ partitioned.yes == cel [5, 3, 4] - assert $ partitioned.no == cel [1, 2] + assertEqual { actual: partitioned.yes, expected: cel [5, 3, 4] } + assertEqual { actual: partitioned.no, expected: cel [1, 2] } log "span should split an list in two based on a predicate" let spanResult = span (_ < 4) (l [1, 2, 3, 4, 5, 6, 7]) - assert $ spanResult.init == cel [1, 2, 3] - assert $ spanResult.rest == cel [4, 5, 6, 7] + assertEqual { actual: spanResult.init, expected: cel [1, 2, 3] } + assertEqual { actual: spanResult.rest, expected: cel [4, 5, 6, 7] } log "take should keep the specified number of items from the front of an list, discarding the rest" - assert $ (take 1 (l [1, 2, 3])) == cel [1] - assert $ (take 2 (l [1, 2, 3])) == cel [1, 2] + assertEqual { actual: (take 1 (l [1, 2, 3])), expected: cel [1] } + assertEqual { actual: (take 2 (l [1, 2, 3])), expected: cel [1, 2] } --assert $ (take 1 nil) == nil - assert $ (take 0 (l [1, 2])) == cel [] - assert $ (take (-1) (l [1, 2])) == cel [] + assertEqual { actual: (take 0 (l [1, 2])), expected: cel [] } + assertEqual { actual: (take (-1) (l [1, 2])), expected: cel [] } log "takeEnd should keep the specified number of items from the end of an list, discarding the rest" assertSkip [SkipBrokenLazyCanEmpty] - \_ -> (takeEnd 1 (l [1, 2, 3])) == cel [3] + \_ -> { actual: takeEnd 1 (l [1, 2, 3]), expected: cel [3] } assertSkip [SkipBrokenLazyCanEmpty] - \_ -> (takeEnd 2 (l [1, 2, 3])) == cel [2, 3] + \_ -> { actual: takeEnd 2 (l [1, 2, 3]), expected: cel [2, 3] } assertSkip [SkipBrokenLazyCanEmpty] - \_ -> (takeEnd 2 (l [1])) == cel [1] + \_ -> { actual: takeEnd 2 (l [1]), expected: cel [1] } --assert $ (takeEnd 1 (l [1, 2, 3])) == cel [3] --assert $ (takeEnd 2 (l [1, 2, 3])) == cel [2, 3] @@ -661,8 +664,8 @@ testCommonDiffEmptiability skip --assert $ (takeEnd 2 (l [1])) == cel [1] log "takeWhile should keep all values that match a predicate from the front of an list" - assert $ (takeWhile (_ /= 2) (l [1, 2, 3])) == cel [1] - assert $ (takeWhile (_ /= 3) (l [1, 2, 3])) == cel [1, 2] + assertEqual { actual: (takeWhile (_ /= 2) (l [1, 2, 3])), expected: cel [1] } + assertEqual { actual: (takeWhile (_ /= 3) (l [1, 2, 3])), expected: cel [1, 2] } --assert $ (takeWhile (_ /= 1) nil) == nil @@ -721,14 +724,14 @@ testOnlyCanEmpty -- Monoid -- mempty :: c log "mempty should not change the collection it is appended to" - assert $ l [5] <> mempty == l [5] + assertEqual { actual: l [5] <> mempty, expected: l [5] } log "mempty should be an empty collection" - assert $ l [] == (mempty :: c Int) + assertEqual { actual: l [], expected: (mempty :: c Int) } -- Plus -- empty :: forall a. c a log "empty should create an empty collection" - assert $ l [] == (empty :: c Int) + assertEqual { actual: l [], expected: (empty :: c Int) } -- Unfoldable -- unfoldr :: forall a b. (b -> Maybe (Tuple a b)) -> b -> c a @@ -738,7 +741,6 @@ testOnlyCanEmpty step :: Int -> Maybe (Tuple Int Int) step n = if n > 5 then Nothing else Just $ Tuple n $ n + 1 - -- assert $ l [1, 2, 3, 4, 5] == unfoldr step 1 assertEqual { actual: unfoldr step 1, expected: l [1, 2, 3, 4, 5] } log "Unfoldable's replicate should be stack-safe" @@ -763,39 +765,39 @@ testOnlyCanEmpty -- non-empty canEmpty list. log "head should return a Just-NEL.NonEmptyListped first value of a non-empty list" - assert $ head (l [1, 2]) == Just 1 + assertEqual { actual: head (l [1, 2]), expected: Just 1 } log "head should return Nothing for an empty list" - assert $ head nil == Nothing + assertEqual { actual: head nil, expected: Nothing } -- Todo - phrasing should be changed to note all but last (not all but first). log "init should return a Just-NEL.NonEmptyListped list containing all the items in an list apart from the first for a non-empty list" - assert $ init (l [1, 2, 3]) == Just (l [1, 2]) + assertEqual { actual: init (l [1, 2, 3]), expected: Just (l [1, 2]) } log "init should return Nothing for an empty list" - assert $ init nil == Nothing + assertEqual { actual: init nil, expected: Nothing } log "last should return a Just-NEL.NonEmptyListped last value of a non-empty list" - assert $ last (l [1, 2]) == Just 2 + assertEqual { actual: last (l [1, 2]), expected: Just 2 } log "last should return Nothing for an empty list" - assert $ last nil == Nothing + assertEqual { actual: last nil, expected: Nothing } log "tail should return a Just-NEL.NonEmptyListped list containing all the items in an list apart from the first for a non-empty list" - assert $ tail (l [1, 2, 3]) == Just (l [2, 3]) + assertEqual { actual: tail (l [1, 2, 3]), expected: Just (l [2, 3]) } log "tail should return Nothing for an empty list" - assert $ tail nil == Nothing + assertEqual { actual: tail nil, expected: Nothing } log "uncons should return nothing when used on an empty list" - assert $ isNothing (uncons nil) + assertEqual { actual: isNothing (uncons nil), expected: true } log "uncons should split an list into a head and tail record when there is at least one item" - assert $ uncons (l [1]) == Just {head: 1, tail: l []} - assert $ uncons (l [1, 2, 3]) == Just {head: 1, tail: l [2, 3]} + assertEqual { actual: uncons (l [1]), expected: Just {head: 1, tail: l []} } + assertEqual { actual: uncons (l [1, 2, 3]), expected: Just {head: 1, tail: l [2, 3]} } @@ -861,20 +863,20 @@ testOnlyNonEmpty -- These are the remaining functions that can't be deduplicated due to use of Maybe log "head should return a the first value" - assert $ head (l [1, 2]) == 1 + assertEqual { actual: head (l [1, 2]), expected: 1 } log "init should return a canEmpty collection of all but the last value" - assert $ init (l [1, 2, 3]) == cel [1, 2] + assertEqual { actual: init (l [1, 2, 3]), expected: cel [1, 2] } log "last should return the last value" - assert $ last (l [1, 2]) == 2 + assertEqual { actual: last (l [1, 2]), expected: 2 } log "tail should return a canEmpty collection of all but the first value" - assert $ tail (l [1, 2, 3]) == cel [2, 3] + assertEqual { actual: tail (l [1, 2, 3]), expected: cel [2, 3] } log "uncons should split a collection into a record containing the first and remaining values" - assert $ uncons (l [1]) == {head: 1, tail: cel []} - assert $ uncons (l [1, 2, 3]) == {head: 1, tail: cel [2, 3]} + assertEqual { actual: uncons (l [1]), expected: {head: 1, tail: cel []} } + assertEqual { actual: uncons (l [1, 2, 3]), expected: {head: 1, tail: cel [2, 3]} } @@ -884,6 +886,7 @@ testOnlyLazy :: forall c. -- Lazy (c Int) => -- missing from LazyNonEmptyList -- Eq (c Int) => + Show (c Int) => OnlyLazy c -> Effect Unit testOnlyLazy { makeCollection @@ -922,21 +925,22 @@ testOnlyLazy todo_replicate1M = replicate1M log "insertAt should add an item at the specified index" - assert $ (insertAt 0 1 (l [2, 3])) == (l [1, 2, 3]) - assert $ (insertAt 1 1 (l [2, 3])) == (l [2, 1, 3]) - assert $ (insertAt 2 1 (l [2, 3])) == (l [2, 3, 1]) + assertEqual { actual: (insertAt 0 1 (l [2, 3])), expected: (l [1, 2, 3]) } + assertEqual { actual: (insertAt 1 1 (l [2, 3])), expected: (l [2, 1, 3]) } + assertEqual { actual: (insertAt 2 1 (l [2, 3])), expected: (l [2, 3, 1]) } log "modifyAt should update an item at the specified index" - assert $ (modifyAt 0 (_ + 1) (l [1, 2, 3])) == (l [2, 2, 3]) - assert $ (modifyAt 1 (_ + 1) (l [1, 2, 3])) == (l [1, 3, 3]) + assertEqual { actual: (modifyAt 0 (_ + 1) (l [1, 2, 3])), expected: (l [2, 2, 3]) } + assertEqual { actual: (modifyAt 1 (_ + 1) (l [1, 2, 3])), expected: (l [1, 3, 3]) } log "updateAt should replace an item at the specified index" - assert $ (updateAt 0 9 (l [1, 2, 3])) == (l [9, 2, 3]) - assert $ (updateAt 1 9 (l [1, 2, 3])) == (l [1, 9, 3]) + assertEqual { actual: (updateAt 0 9 (l [1, 2, 3])), expected: (l [9, 2, 3]) } + assertEqual { actual: (updateAt 1 9 (l [1, 2, 3])), expected: (l [1, 9, 3]) } testOnlyStrict :: forall c. Eq (c Int) => + Show (c Int) => OnlyStrict c -> Effect Unit testOnlyStrict { makeCollection @@ -983,11 +987,11 @@ testOnlyStrict -- missing from original test suite log "updateAt should replace an item at the specified index" - assert $ (updateAt 0 9 (l [1, 2, 3])) == Just (l [9, 2, 3]) - assert $ (updateAt 1 9 (l [1, 2, 3])) == Just (l [1, 9, 3]) + assertEqual { actual: (updateAt 0 9 (l [1, 2, 3])), expected: Just (l [9, 2, 3]) } + assertEqual { actual: (updateAt 1 9 (l [1, 2, 3])), expected: Just (l [1, 9, 3]) } log "updateAt should return Nothing if the index is out of range" - assert $ (updateAt 5 9 (l [1, 2, 3])) == Nothing + assertEqual { actual: (updateAt 5 9 (l [1, 2, 3])), expected: Nothing } @@ -1011,8 +1015,8 @@ testOnlyStrictCanEmpty { deleteAt } = do -- Common function names, but different signatures log "deleteAt should remove an item at the specified index" - assert $ deleteAt 0 (l [1, 2, 3]) == Just (l [2, 3]) - assert $ deleteAt 1 (l [1, 2, 3]) == Just (l [1, 3]) + assertEqual { actual: deleteAt 0 (l [1, 2, 3]), expected: Just (l [2, 3]) } + assertEqual { actual: deleteAt 1 (l [1, 2, 3]), expected: Just (l [1, 3]) } -- Corner Cases @@ -1058,8 +1062,8 @@ testOnlyLazyCanEmpty -- Common function names, but different signatures log "deleteAt should remove an item at the specified index" - assert $ deleteAt 0 (l [1, 2, 3]) == l [2, 3] - assert $ deleteAt 1 (l [1, 2, 3]) == l [1, 3] + assertEqual { actual: deleteAt 0 (l [1, 2, 3]), expected: l [2, 3] } + assertEqual { actual: deleteAt 1 (l [1, 2, 3]), expected: l [1, 3] } -- Corner Cases @@ -1087,8 +1091,8 @@ testOnlyLazyNonEmpty { deleteAt } = do -- Common function names, but different signatures log "deleteAt should remove an item at the specified index" - assert $ deleteAt 0 (l [1, 2, 3]) == cel [2, 3] - assert $ deleteAt 1 (l [1, 2, 3]) == cel [1, 3] + assertEqual { actual: deleteAt 0 (l [1, 2, 3]), expected: cel [2, 3] } + assertEqual { actual: deleteAt 1 (l [1, 2, 3]), expected: cel [1, 3] } -- Corner Cases From 039f8663158518e85438389d0d4b94f937712593 Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Wed, 23 Jun 2021 15:10:52 -0700 Subject: [PATCH 18/18] Add more tests and reorganize --- src/Data/List/Lazy/NonEmpty.purs | 2 +- src/Data/List/Lazy/Types.purs | 4 + src/Data/List/NonEmpty.purs | 17 +- test/Test/API.purs | 46 +- test/Test/AllTests.purs | 1606 +++++++++++++++++++------- test/Test/Args/LazyList.purs | 9 +- test/Test/Args/LazyNonEmptyList.purs | 11 +- test/Test/Args/List.purs | 9 +- test/Test/Args/NonEmptyList.purs | 6 +- test/Test/UpdatedTests.purs | 29 +- 10 files changed, 1252 insertions(+), 487 deletions(-) diff --git a/src/Data/List/Lazy/NonEmpty.purs b/src/Data/List/Lazy/NonEmpty.purs index 9525892..33f4d87 100644 --- a/src/Data/List/Lazy/NonEmpty.purs +++ b/src/Data/List/Lazy/NonEmpty.purs @@ -269,7 +269,7 @@ stripPrefix _ _ = unsafeCrashWith "todo stripPrefix for LazyNonEmptyList" deleteAt :: forall a. Int -> NonEmptyList a -> L.List a deleteAt _ _ = unsafeCrashWith "todo deleteAt for LazyNonEmptyList" -alterAt :: forall a. Int -> (a -> Maybe a) -> NonEmptyList a -> NonEmptyList a +alterAt :: forall a. Int -> (a -> Maybe a) -> NonEmptyList a -> L.List a alterAt _ _ _ = unsafeCrashWith "todo alterAt for LazyNonEmptyList" cycle :: forall a. NonEmptyList a -> NonEmptyList a diff --git a/src/Data/List/Lazy/Types.purs b/src/Data/List/Lazy/Types.purs index f313a79..b28c30a 100644 --- a/src/Data/List/Lazy/Types.purs +++ b/src/Data/List/Lazy/Types.purs @@ -25,6 +25,7 @@ import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) import Data.Tuple (Tuple(..), snd) import Data.Unfoldable (class Unfoldable, unfoldr1) import Data.Unfoldable1 (class Unfoldable1) +import Partial.Unsafe (unsafeCrashWith) -- | A lazy linked list. newtype List a = List (Lazy (Step a)) @@ -296,3 +297,6 @@ instance foldableWithIndexNonEmptyList :: FoldableWithIndex Int NonEmptyList whe instance traversableWithIndexNonEmptyList :: TraversableWithIndex Int NonEmptyList where traverseWithIndex f (NonEmptyList ne) = map (\xxs -> NonEmptyList $ defer \_ -> xxs) $ traverseWithIndex (f <<< maybe 0 (add 1)) $ force ne + +instance lazyNonEmptyList :: Z.Lazy (NonEmptyList a) where + defer _ = unsafeCrashWith "todo defer (Lazy instance) for Lazy NonEmptyList" diff --git a/src/Data/List/NonEmpty.purs b/src/Data/List/NonEmpty.purs index ba5e1cb..ea4772f 100644 --- a/src/Data/List/NonEmpty.purs +++ b/src/Data/List/NonEmpty.purs @@ -87,6 +87,7 @@ import Control.Alternative (class Alternative) import Control.Lazy (class Lazy) import Control.Monad.Rec.Class (class MonadRec) import Data.Foldable (class Foldable) +import Data.Foldable (foldl, foldr, foldMap, fold, intercalate, elem, notElem, find, findMap, any, all) as Exports import Data.FunctorWithIndex (mapWithIndex) as FWI import Data.List ((:)) import Data.List as L @@ -95,16 +96,13 @@ import Data.Maybe (Maybe(..), fromJust, fromMaybe, maybe) import Data.Newtype (class Newtype) import Data.NonEmpty ((:|)) import Data.NonEmpty as NE +import Data.Semigroup.Foldable (fold1, foldMap1, for1_, sequence1_, traverse1_) as Exports import Data.Semigroup.Traversable (sequence1) +import Data.Semigroup.Traversable (sequence1, traverse1, traverse1Default) as Exports +import Data.Traversable (scanl, scanr) as Exports import Data.Tuple (Tuple(..), fst, snd) import Data.Unfoldable (class Unfoldable, unfoldr) import Partial.Unsafe (unsafeCrashWith, unsafePartial) - -import Data.Foldable (foldl, foldr, foldMap, fold, intercalate, elem, notElem, find, findMap, any, all) as Exports -import Data.Semigroup.Foldable (fold1, foldMap1, for1_, sequence1_, traverse1_) as Exports -import Data.Semigroup.Traversable (sequence1, traverse1, traverse1Default) as Exports -import Data.Traversable (scanl, scanr) as Exports - import Prim.TypeError (class Warn, Text) --- Sorted additions ------ @@ -136,7 +134,7 @@ stripPrefix _ _ = unsafeCrashWith "todo stripPrefix for NonEmptyList" deleteAt :: forall a. Int -> NonEmptyList a -> Maybe (L.List a) deleteAt _ _ = unsafeCrashWith "todo deleteAt for NonEmptyList" -alterAt :: forall a. Int -> (a -> Maybe a) -> NonEmptyList a -> Maybe (NonEmptyList a) +alterAt :: forall a. Int -> (a -> Maybe a) -> NonEmptyList a -> Maybe (L.List a) alterAt _ _ _ = unsafeCrashWith "todo alterAt for NonEmptyList" -- | Internal function: any operation on a list that is guaranteed not to delete @@ -192,9 +190,10 @@ singleton = NonEmptyList <<< NE.singleton infix 8 range as .. -- | Create a list containing a range of integers, including both endpoints. --- Todo, rewrite this without unsafe workaround (if necessary) range :: Int -> Int -> NonEmptyList Int -range start end = unsafePartial fromJust $ fromList $ L.range start end +range start end | start < end = cons' start (L.range (start + 1) end) + | start > end = cons' start (L.range (start - 1) end) + | otherwise = singleton start cons :: forall a. a -> NonEmptyList a -> NonEmptyList a cons y (NonEmptyList (x :| xs)) = NonEmptyList (y :| x : xs) diff --git a/test/Test/API.purs b/test/Test/API.purs index 5e97769..fd50cdb 100644 --- a/test/Test/API.purs +++ b/test/Test/API.purs @@ -57,6 +57,7 @@ type CommonDiffEmptiability c cInverse canEmpty nonEmpty cPattern = , makeCanEmptyCollection :: forall f a. Foldable f => f a -> canEmpty a , makeNonEmptyCollection :: forall f a. Foldable f => f a -> nonEmpty a + , makeInverseCollection :: forall f a. Foldable f => f a -> cInverse a , catMaybes :: forall a. c (Maybe a) -> canEmpty a , drop :: forall a. Int -> c a -> canEmpty a @@ -85,9 +86,13 @@ type CommonDiffEmptiability c cInverse canEmpty nonEmpty cPattern = , stripPrefix :: forall a. Eq a => cPattern a -> c a -> Maybe (canEmpty a) } -type OnlyCanEmpty c nonEmpty = +type OnlyCanEmpty c = { makeCollection :: forall f a. Foldable f => f a -> c a - , makeNonEmptyCollection :: forall f a. Foldable f => f a -> nonEmpty a + + -- These functions are not available for non-empty collections + , null :: forall a. c a -> Boolean + , many :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) + , manyRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) -- These are the same function names as the NonEmpty versions, -- but the signatures are different and can't be merged in the @@ -100,39 +105,32 @@ type OnlyCanEmpty c nonEmpty = , tail :: forall a. c a -> Maybe (c a) , uncons :: forall a. c a -> Maybe { head :: a, tail :: c a } - -- These are not available for non-empty collections - , null :: forall a. c a -> Boolean - , many :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) - , manyRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) } type OnlyNonEmpty c canEmpty = { makeCollection :: forall f a. Foldable f => f a -> c a , makeCanEmptyCollection :: forall f a. Foldable f => f a -> canEmpty a + -- These functions are only available for NonEmpty collections + , fromList :: forall a. canEmpty a -> Maybe (c a) + , toList :: c ~> canEmpty + -- These are the same function names as the CanEmpty versions, -- but the signatures are different and can't be merged in the -- CommonDiffEmptiability tests. This is due to a mismatch in the -- presence of `Maybe`s. - , fromFoldable :: forall f a. Foldable f => f a -> Maybe (c a) , head :: forall a. c a -> a , init :: forall a. c a -> canEmpty a , last :: forall a. c a -> a , tail :: forall a. c a -> canEmpty a , uncons :: forall a. c a -> { head :: a, tail :: canEmpty a } - - -- These are only available for NonEmpty collections - - , fromList :: forall a. canEmpty a -> Maybe (c a) - , toList :: c ~> canEmpty } type OnlyStrict c = { makeCollection :: forall f a. Foldable f => f a -> c a -- Same names, but different APIs (with Maybe) - , alterAt :: forall a. Int -> (a -> Maybe a) -> c a -> Maybe (c a) , insertAt :: forall a. Int -> a -> c a -> Maybe (c a) , modifyAt :: forall a. Int -> (a -> a) -> c a -> Maybe (c a) , updateAt :: forall a. Int -> a -> c a -> Maybe (c a) @@ -140,17 +138,17 @@ type OnlyStrict c = type OnlyLazy c = { makeCollection :: forall f a. Foldable f => f a -> c a + , takeSimple :: forall a. Int -> c a -> c a -- Same names, but different APIs (without Maybe) - , alterAt :: forall a. Int -> (a -> Maybe a) -> c a -> c a , insertAt :: forall a. Int -> a -> c a -> c a , modifyAt :: forall a. Int -> (a -> a) -> c a -> c a , updateAt :: forall a. Int -> a -> c a -> c a -- These are only available for Lazy collections - , iterate :: forall a. (a -> a) -> a -> c a , repeat :: forall a. a -> c a , cycle :: forall a. c a -> c a + , iterate :: forall a. (a -> a) -> a -> c a , foldrLazy :: forall a b. Lazy b => (a -> b -> b) -> b -> c a -> b , scanlLazy :: forall a b. (b -> a -> b) -> b -> c a -> c b @@ -162,36 +160,34 @@ type OnlyLazy c = -- Non Overlapping APIs -type OnlyStrictCanEmpty :: forall k. (k -> Type) -> Type type OnlyStrictCanEmpty c = { -- Same names, but different APIs - deleteAt :: forall a. Int -> c a -> Maybe (c a) + alterAt :: forall a. Int -> (a -> Maybe a) -> c a -> Maybe (c a) + , deleteAt :: forall a. Int -> c a -> Maybe (c a) } -type OnlyStrictNonEmpty :: forall k. (k -> Type) -> (k -> Type) -> Type type OnlyStrictNonEmpty c canEmpty = { -- Same names, but different APIs - deleteAt :: forall a. Int -> c a -> Maybe (canEmpty a) + alterAt :: forall a. Int -> (a -> Maybe a) -> c a -> Maybe (canEmpty a) + , deleteAt :: forall a. Int -> c a -> Maybe (canEmpty a) } --- Todo - investigate why kind signature is only recommended when --- records contain only a single field - type OnlyLazyCanEmpty c = { -- Same names, but different APIs - deleteAt :: forall a. Int -> c a -> c a + alterAt :: forall a. Int -> (a -> Maybe a) -> c a -> c a + , deleteAt :: forall a. Int -> c a -> c a -- Unique functions -- Specialized from Unfoldable's replicate / replicateA , replicate :: forall a. Int -> a -> c a , replicateM :: forall m a. Monad m => Int -> m a -> m (c a) } -type OnlyLazyNonEmpty :: forall k. (k -> Type) -> (k -> Type) -> Type type OnlyLazyNonEmpty c canEmpty = { -- Same names, but different APIs - deleteAt :: forall a. Int -> c a -> canEmpty a + alterAt :: forall a. Int -> (a -> Maybe a) -> c a -> canEmpty a + , deleteAt :: forall a. Int -> c a -> canEmpty a } \ No newline at end of file diff --git a/test/Test/AllTests.purs b/test/Test/AllTests.purs index 3a051ab..4aedb8e 100644 --- a/test/Test/AllTests.purs +++ b/test/Test/AllTests.purs @@ -6,13 +6,12 @@ import Control.Alt (class Alt, (<|>)) import Control.Alternative (class Alternative, class Plus, empty) import Control.Comonad (class Comonad) import Control.Extend (class Extend, (<<=)) -import Control.Lazy (class Lazy) -import Control.Monad.Rec.Class (class MonadRec) +import Control.Lazy (class Lazy, defer) import Control.MonadPlus (class MonadPlus) import Control.MonadZero (class MonadZero) import Data.Array as Array import Data.Eq (class Eq1, eq1) -import Data.Foldable (class Foldable, foldMap, foldl, sum, traverse_) +import Data.Foldable (class Foldable, foldMap, foldl, foldr, sum, traverse_) import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex) import Data.Function (on) import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) @@ -21,13 +20,13 @@ import Data.List as L import Data.List.Lazy as LL import Data.List.Lazy.NonEmpty as LNEL import Data.List.NonEmpty as NEL -import Data.Maybe (Maybe(..), fromJust, isNothing) +import Data.Maybe (Maybe(..), fromJust) import Data.Monoid.Additive (Additive(..)) import Data.Ord (class Ord1, compare1) -import Data.Traversable (class Traversable, traverse) +import Data.Traversable (class Traversable, sequence, traverse) import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) import Data.Tuple (Tuple(..)) -import Data.Unfoldable (class Unfoldable, replicate1A, unfoldr) +import Data.Unfoldable (class Unfoldable, unfoldr) import Data.Unfoldable as Unfoldable import Data.Unfoldable1 (class Unfoldable1, unfoldr1) import Data.Unfoldable1 as Unfoldable1 @@ -35,7 +34,13 @@ import Effect (Effect) import Effect.Console (log) import Partial.Unsafe (unsafePartial) import Test.API (Common, CommonDiffEmptiability, OnlyCanEmpty, OnlyLazy, OnlyLazyCanEmpty, OnlyNonEmpty, OnlyStrict, OnlyStrictCanEmpty, OnlyStrictNonEmpty, OnlyLazyNonEmpty) -import Test.Assert (assert, assertEqual, assertEqual') +import Test.Assert (assertEqual, assertEqual', assertFalse, assertTrue) + +{- +Todos + +Improve typeclass law checking +-} {- This "Skip" code is temporarily being used during development. @@ -64,6 +69,10 @@ assertSkipHelper skip arr f = true -> log "...skipped" false -> assertEqual $ f unit +assertSkipAlways :: forall a. (Unit -> AssertRec a) -> Effect Unit +assertSkipAlways _ = + log "...skipped" + printCollectionType :: String -> Effect Unit printCollectionType str = do log "--------------------------------" @@ -94,21 +103,24 @@ testCommon :: forall c. Traversable c => TraversableWithIndex Int c => Unfoldable1 c => - -- + -- The below contraints are for unit testing asserts: Eq (c String) => Eq (c (Tuple Int String)) => Eq (c (c String)) => - Eq (c (c Int)) => -- temp + Eq (c (c Int)) => Eq (c (Array Int)) => Show (c String) => Show (c (Tuple Int String)) => Show (c (c String)) => - Show (c (c Int)) => -- temp + Show (c (c Int)) => Show (c (Array Int)) => - Common c -> Effect Unit + -- parameters: + Common c -> + Effect Unit testCommon - r@{ makeCollection + { makeCollection + , appendFoldable , concat , concatMap , cons @@ -118,16 +130,25 @@ testCommon , findLastIndex , foldM , index + , insert + , insertBy , intersect , intersectBy , length + , nub + , nubBy , nubEq , nubByEq , range , reverse , singleton , snoc + , some + , someRec + , sort + , sortBy , toUnfoldable + , transpose , union , unionBy , unzip @@ -135,19 +156,8 @@ testCommon , zipWith , zipWithA - , appendFoldable - , insert - , insertBy - , nub - , nubBy - , some - , someRec - , sort - , sortBy - , transpose } = do let - -- l :: forall f a. Foldable f => f a -> c a l = makeCollection rg :: Int -> Int -> c Int @@ -158,7 +168,7 @@ testCommon printTestType "Common" - -- Duplicating this test out of alphabetical order, since many other tests rely on it. + -- Testing range asap, since many other tests rely on it. log "range should create an inclusive collection of integers for the specified start and end" assertEqual { actual: range 3 3, expected: l [3] } assertEqual { actual: range 0 5, expected: l [0, 1, 2, 3, 4, 5] } @@ -168,116 +178,135 @@ testCommon -- Alt -- alt :: forall a. f a -> f a -> f a - -- Todo - Don't know in what situations this is different than append + log "Alt's alt (<|>) should append collections" assertEqual { actual: l [1,2] <|> l [3,4], expected: l [1,2,3,4] } -- Applicative -- pure :: forall a. a -> f a + log "Applicative's pure should construct a collection with a single value" assertEqual { actual: pure 5, expected: l [5] } -- Apply -- apply :: forall a b. f (a -> b) -> f a -> f b + + -- Todo - Fix ordering mismatch between list types. Also ensure ordering is the same for arrays. + log "Apply's apply (<*>) should have cartesian product behavior for non-zippy collections" - log "... skipped" - -- Todo - make these consistent and also double-check for arrays - -- can-empty behavior - assertEqual { actual: makeCollection [mul 10, mul 100] <*> l [1, 2, 3], expected: l [10, 20, 30, 100, 200, 300] } - -- NonEmpty behavior - -- assertEqual { actual: makeCollection [mul 10, mul 100] <*> l [1, 2, 3], expected: l [10, 100, 20, 200, 30, 300] } + assertEqual { actual: l [mul 10, mul 100] <*> l [1, 2, 3], expected: l [10, 20, 30, 100, 200, 300] } -- Bind c -- bind :: forall a b. m a -> (a -> m b) -> m b + log "Bind's bind (>>=) should append the results of a collection-generating function\ \applied to each element in the collection" assertEqual { actual: l [1,2,3] >>= \x -> l [x,10+x], expected: l [1,11,2,12,3,13] } -- Eq -- eq :: a -> a -> Boolean + log "Eq's eq (==) should correctly test collections for equality" assertEqual' "Equality failed" { actual: l [1,2] == l [1,2], expected: true } assertEqual' "Inequality failed" { actual: l [1,2] == l [2,2], expected: false } -- Eq1 -- eq1 :: forall a. Eq a => f a -> f a -> Boolean + log "Eq1's eq1 should correctly test collections for equality" assertEqual' "Equality failed" { actual: l [1,2] `eq1` l [1,2], expected: true } assertEqual' "Inequality failed" { actual: l [1,2] `eq1` l [2,2], expected: false } -- Extend -- extend :: forall b a. (w a -> b) -> w a -> w b + log "Extend's extend (<<=) should create a collection containing the results\ \of a function that is applied to increasingly smaller chunks of an input\ \collection. Each iteration drops an element from the front of the input collection." assertEqual { actual: sum <<= l [1,2,3,4], expected: l [10,9,7,4] } -- Foldable - -- foldr :: forall a b. (a -> b -> b) -> b -> f a -> b -- foldl :: forall a b. (b -> a -> b) -> b -> f a -> b + -- foldr :: forall a b. (a -> b -> b) -> b -> f a -> b -- foldMap :: forall a m. Monoid m => (a -> m) -> f a -> m - -- These are just the pre-existing tests. They could be more comprehensive. - log "foldl should be stack-safe" - void $ pure $ foldl (+) 0 bigCollection + log "Foldable's foldl should correctly fold left-to-right" + assertEqual { actual: foldl (\b a -> b * 10 + a) 0 $ rg 1 5, expected: 12345 } - log "foldMap should be stack-safe" - void $ pure $ foldMap Additive bigCollection + log "Foldable's foldr should correctly fold right-to-left" + assertEqual { actual: foldr (\a b -> b * 10 + a) 0 $ rg 1 5, expected: 54321 } - log "foldMap should be left-to-right" + log "Foldable's foldMap should be left-to-right" assertEqual { actual: foldMap show $ rg 1 5, expected: "12345" } + log "Foldable's foldl should be stack-safe" + void $ pure $ foldl (+) 0 bigCollection + + log "Foldable's foldr should be stack-safe" + void $ pure $ foldr (+) 0 bigCollection + + log "Foldable's foldMap should be stack-safe" + void $ pure $ foldMap Additive bigCollection + -- FoldableWithIndex - -- foldrWithIndex :: forall a b. (i -> a -> b -> b) -> b -> f a -> b -- foldlWithIndex :: forall a b. (i -> b -> a -> b) -> b -> f a -> b + -- foldrWithIndex :: forall a b. (i -> a -> b -> b) -> b -> f a -> b -- foldMapWithIndex :: forall a m. Monoid m => (i -> a -> m) -> f a -> m - -- Todo - Existing tests, opportunities for improvement - log "foldlWithIndex should be correct" - assertEqual { actual: foldlWithIndex (\i b _ -> i + b) 0 $ rg 0 10000, expected: 50005000 } + log "FoldableWithIndex's foldlWithIndex should correctly fold left-to-right" + assertEqual { actual: foldlWithIndex (\_ b a -> b * 10 + a) 0 $ rg 1 5, expected: 12345 } - log "foldlWithIndex should be stack-safe" - void $ pure $ foldlWithIndex (\i b _ -> i + b) 0 bigCollection + log "FoldableWithIndex's foldrWithIndex should correctly fold right-to-left" + assertEqual { actual: foldrWithIndex (\_ a b -> b * 10 + a) 0 $ rg 1 5, expected: 54321 } + + log "FoldableWithIndex's foldMapWithIndex should be left-to-right" + assertEqual { actual: foldMapWithIndex (\_ a -> show a) $ rg 1 5, expected: "12345" } + + + log "FoldableWithIndex's foldlWithIndex should increment indices" + assertEqual { actual: foldlWithIndex (\i b _ -> b * 10 + i) 0 $ l [0, 0, 0, 0, 0], expected: 1234 } + + log "FoldableWithIndex's foldrWithIndex should decrement indices" + assertEqual { actual: foldrWithIndex (\i _ b -> b * 10 + i) 0 $ l [0, 0, 0, 0, 0], expected: 43210 } + + log "FoldableWithIndex's foldMapWithIndex should increment indices" + assertEqual { actual: foldMapWithIndex (\i _ -> show i) $ l [0, 0, 0, 0, 0], expected: "01234" } - log "foldrWithIndex should be correct" - assertEqual { actual: foldrWithIndex (\i _ b -> i + b) 0 $ rg 0 10000, expected: 50005000 } - log "foldrWithIndex should be stack-safe" + log "FoldableWithIndex's foldlWithIndex should be stack-safe" + void $ pure $ foldlWithIndex (\i b _ -> i + b) 0 bigCollection + + log "FoldableWithIndex's foldrWithIndex should be stack-safe" void $ pure $ foldrWithIndex (\i _ b -> i + b) 0 bigCollection - log "foldMapWithIndex should be stack-safe" + log "FoldableWithIndex's foldMapWithIndex should be stack-safe" void $ pure $ foldMapWithIndex (\i _ -> Additive i) bigCollection - log "foldMapWithIndex should be left-to-right" - assertEqual { actual: foldMapWithIndex (\i _ -> show i) (l [0, 0, 0]), expected: "012" } - -- Functor -- map :: forall a b. (a -> b) -> f a -> f b - log "map should maintain order" - assertEqual { actual: rg 1 5, expected: map identity $ rg 1 5 } + log "Functor's map should be correct" + assertEqual { actual: map (add 1) $ rg 0 4, expected: rg 1 5 } - log "map should be stack-safe" + log "Functor's map should be stack-safe" void $ pure $ map identity bigCollection - -- Todo - The below test also performs the same stack-safety check - - log "map should be correct" - assertEqual { actual: rg 1 100000, expected: map (_ + 1) $ rg 0 99999 } - -- FunctorWithIndex -- mapWithIndex :: forall a b. (i -> a -> b) -> f a -> f b - -- Todo - improve pre-existing - log "mapWithIndex should take a collection of values and apply a function which also takes the index into account" - assertEqual { actual: mapWithIndex add $ l [0, 1, 2, 3], expected: l [0, 2, 4, 6] } + log "FunctorWithIndex's mapWithIndex should take a collection of values and apply a function which also takes the index into account" + assertEqual { actual: mapWithIndex add $ l [10, 10, 10, 10, 10], expected: l [10, 11, 12, 13, 14] } + + log "FunctorWithIndex's mapWithIndex should be stack-safe" + void $ pure $ mapWithIndex add bigCollection -- Monad -- Indicates Applicative and Bind, which are already tested above -- Ord -- compare :: a -> a -> Ordering - log "compare should determine the ordering of two collections" + + log "Ord's compare should determine the ordering of two collections" assertEqual { actual: compare (l [1]) (l [1]), expected: EQ } assertEqual { actual: compare (l [0]) (l [1]), expected: LT } assertEqual { actual: compare (l [2]) (l [1]), expected: GT } @@ -288,7 +317,8 @@ testCommon -- Ord1 -- compare1 :: forall a. Ord a => f a -> f a -> Ordering - log "compare1 should determine the ordering of two collections" + + log "Ord1's compare1 should determine the ordering of two collections" assertEqual { actual: compare1 (l [1]) (l [1]), expected: EQ } assertEqual { actual: compare1 (l [0]) (l [1]), expected: LT } assertEqual { actual: compare1 (l [2]) (l [1]), expected: GT } @@ -300,10 +330,10 @@ testCommon -- Semigroup -- append :: a -> a -> a - log "append should concatenate two collections" + log "Semigroup's append (<>) should concatenate two collections" assertEqual { actual: l [1, 2] <> l [3, 4], expected: l [1, 2, 3, 4] } - log "append should be stack-safe" + log "Semigroup's append (<>) should be stack-safe" void $ pure $ bigCollection <> bigCollection -- Show @@ -313,20 +343,35 @@ testCommon -- Traversable -- traverse :: forall a b m. Applicative m => (a -> m b) -> t a -> m (t b) -- sequence :: forall a m. Applicative m => t (m a) -> m (t a) - -- Todo - improve pre-existing tests - -- Todo - add sequence test - log "traverse should be stack-safe" + let + safeDiv :: Int -> Int -> Maybe Int + safeDiv _ 0 = Nothing + safeDiv n d = Just $ n / d + + log "Traversable's traverse should be correct" + assertEqual { actual: traverse (safeDiv 12) $ l [1, 2, 3, 4], expected: Just $ l [12, 6, 4, 3] } + assertEqual { actual: traverse (safeDiv 12) $ l [1, 2, 0, 4], expected: Nothing } + + log "Traversable's sequence should be correct" + assertEqual { actual: sequence $ l [Just 1, Just 2, Just 3], expected: Just $ l [1, 2, 3] } + assertEqual { actual: sequence $ l [Just 1, Nothing, Just 3], expected: Nothing } + + log "Traversable's traverse should be stack-safe" assertEqual { actual: traverse Just bigCollection, expected: Just bigCollection } + log "Traversable's sequence should be stack-safe" + assertEqual { actual: sequence $ map Just bigCollection, expected: Just bigCollection } + -- TraversableWithIndex -- traverseWithIndex :: forall a b m. Applicative m => (i -> a -> m b) -> t a -> m (t b) - log "traverseWithIndex should be stack-safe" - assertEqual { actual: traverseWithIndex (const Just) bigCollection, expected: Just bigCollection } + log "TraversableWithIndex's traverseWithIndex should be correct" + assertEqual { actual: traverseWithIndex safeDiv $ l [2, 2, 2, 2], expected: Just $ l [0, 0, 1, 1] } + assertEqual { actual: traverseWithIndex safeDiv $ l [2, 2, 0, 2], expected: Nothing } - log "traverseWithIndex should be correct" - assertEqual { actual: traverseWithIndex (\i a -> Just $ i + a) (l [2, 2, 2]), expected: Just $ l [2, 3, 4] } + log "TraversableWithIndex's traverseWithIndex should be stack-safe" + assertEqual { actual: traverseWithIndex (const Just) bigCollection, expected: Just bigCollection } -- Unfoldable1 -- unfoldr1 :: forall a b. (b -> Tuple a (Maybe b)) -> b -> t a @@ -335,32 +380,35 @@ testCommon step1 :: Int -> Tuple Int (Maybe Int) step1 n = Tuple n $ if n >= 5 then Nothing else Just $ n + 1 - log "unfoldr1 should maintain order" - assertEqual { actual: rg 1 5, expected: unfoldr1 step1 1 } + log "Unfoldable1's unfoldr1 should maintain order" + assertEqual { actual: unfoldr1 step1 1, expected: rg 1 5 } + + log "Unfoldable1's replicate1 should be correct" + assertEqual { actual: Unfoldable1.replicate1 3 1, expected: l [1, 1, 1] } + assertEqual { actual: Unfoldable1.replicate1 1 1, expected: l [1] } + assertEqual { actual: Unfoldable1.replicate1 0 1, expected: l [1] } + assertEqual { actual: Unfoldable1.replicate1 (-1) 1, expected: l [1] } log "Unfoldable1's replicate1 should be stack-safe" - void $ pure $ r.length $ (Unfoldable1.replicate1 100000 1 :: c Int) + assertEqual { actual: length (Unfoldable1.replicate1 100000 1), expected: 100000 } -- =========== Functions =========== - -- These bindings are to suppress warning squiggles covering this entire function. - -- Can remove these and record accessor workaround once this issue is resolved: - -- https://github.com/purescript/purescript/issues/3938 - let - no_warn_unused_concat = concat - no_warn_unused_reverse = reverse - no_warn_unused_unzip = unzip + log "appendFoldable should append a foldable collection to another collection" + assertEqual { actual: appendFoldable (l [1, 2, 3]) [4, 5], expected: l [1, 2, 3, 4, 5] } + assertEqual { actual: appendFoldable (l [1, 2, 3]) [], expected: l [1, 2, 3] } log "concat should join a collection of collections" - assertEqual { actual: r.concat $ l [l [1, 2], l [3, 4]], expected: l [1, 2, 3, 4] } - assertEqual { actual: r.concat $ l [l [1, 2], l [3, 4]], expected: l [1, 2, 3, 4] } + assertEqual { actual: concat (l [l [1, 2], l [3, 4]]), expected: l [1, 2, 3, 4] } + assertEqual { actual: concat (l [l [1, 2]]), expected: l [1, 2] } let doubleAndOrig :: Int -> c Int doubleAndOrig x = cons (x * 2) $ singleton x log "concatMap should be equivalent to (concat <<< map)" - assertEqual { actual: concatMap doubleAndOrig $ l [1, 2, 3], expected: r.concat $ map doubleAndOrig $ l [1, 2, 3] } + assertEqual { actual: concatMap doubleAndOrig $ l [1, 2, 3], expected: concat (map doubleAndOrig $ l [1, 2, 3]) } + assertEqual { actual: concatMap doubleAndOrig $ l [1, 2, 3], expected: l [2, 1, 4, 2, 6, 3] } log "cons should add an element to the front of the collection" assertEqual { actual: cons 1 $ l [2, 3], expected: l [1,2,3] } @@ -368,11 +416,12 @@ testCommon log "elemIndex should return the index of an item that a predicate returns true for in a collection" assertEqual { actual: elemIndex 1 $ l [1, 2, 1], expected: Just 0 } assertEqual { actual: elemIndex 4 $ l [1, 2, 1], expected: Nothing } + assertEqual { actual: elemIndex (-1) $ l [1, 2, 1], expected: Nothing } log "elemLastIndex should return the last index of an item in a collection" assertEqual { actual: elemLastIndex 1 $ l [1, 2, 1], expected: Just 2 } assertEqual { actual: elemLastIndex 4 $ l [1, 2, 1], expected: Nothing } - + assertEqual { actual: elemLastIndex (-1) $ l [1, 2, 1], expected: Nothing } log "findIndex should return the index of an item that a predicate returns true for in a collection" assertEqual { actual: findIndex (_ /= 1) $ l [1, 2, 1], expected: Just 1 } @@ -383,8 +432,11 @@ testCommon assertEqual { actual: findLastIndex (_ == 3) $ l [2, 1, 2], expected: Nothing } log "foldM should perform a fold using a monadic step function" - assertEqual { actual: foldM (\x y -> Just $ x + y) 0 $ rg 1 10, expected: Just 55 } - assertEqual { actual: foldM (\_ _ -> Nothing) 0 $ rg 1 10, expected: Nothing } + let + foldMFunc _ 0 = Nothing + foldMFunc x y = Just $ x + y + assertEqual { actual: foldM foldMFunc 0 $ l [1, 2, 3, 4], expected: Just 10 } + assertEqual { actual: foldM foldMFunc 0 $ l [1, 2, 0, 4], expected: Nothing } log "index (!!) should return Just x when the index is within the bounds of the collection" assertEqual { actual: l [1, 2, 3] `index` 0, expected: Just 1 } @@ -395,6 +447,15 @@ testCommon assertEqual { actual: l [1, 2, 3] `index` 6, expected: Nothing } assertEqual { actual: l [1, 2, 3] `index` (-1), expected: Nothing } + log "insert should add an item at the appropriate place in a sorted collection" + assertEqual { actual: insert 2 $ l [1, 1, 3], expected: l [1, 1, 2, 3] } + assertEqual { actual: insert 4 $ l [1, 2, 3], expected: l [1, 2, 3, 4] } + assertEqual { actual: insert 0 $ l [1, 2, 3], expected: l [0, 1, 2, 3] } + + log "insertBy should add an item at the appropriate place in a sorted collection using the specified comparison" + assertEqual { actual: insertBy (flip compare) 4 $ l [1, 2, 3], expected: l [4, 1, 2, 3] } + assertEqual { actual: insertBy (flip compare) 0 $ l [1, 2, 3], expected: l [1, 2, 3, 0] } + log "intersect should return the intersection of two collections" assertEqual { actual: intersect (l [1, 2, 3, 4, 3, 2, 1]) $ l [1, 1, 2, 3], expected: l [1, 2, 3, 3, 2, 1] } @@ -402,12 +463,18 @@ testCommon assertEqual { actual: intersectBy (\x y -> x * 2 == y) (l [1, 2, 3]) $ l [2, 6], expected: l [1, 3] } log "length should return the number of items in a collection" - assertEqual { actual: r.length $ l [1], expected: 1 } - assertEqual { actual: r.length $ l [1, 2, 3, 4, 5], expected: 5 } + assertEqual { actual: length (l [1]), expected: 1 } + assertEqual { actual: length (l [1, 2, 3, 4, 5]), expected: 5 } log "length should be stack-safe" void $ pure $ length bigCollection + log "nub should remove duplicate elements from a collection, keeping the first occurrence" + assertEqual { actual: nub (l [1, 2, 2, 3, 4, 1]), expected: l [1, 2, 3, 4] } + + log "nubBy should remove duplicate items from a collection using a supplied predicate" + assertEqual { actual: nubBy (compare `on` Array.length) $ l [[1],[2],[3,4]], expected: l [[1],[3,4]] } + log "nubEq should remove duplicate elements from the collection, keeping the first occurence" assertEqual { actual: nubEq (l [1, 2, 2, 3, 4, 1]), expected: l [1, 2, 3, 4] } @@ -415,13 +482,8 @@ testCommon let mod3eq = eq `on` \n -> mod n 3 assertEqual { actual: nubByEq mod3eq $ l [1, 3, 4, 5, 6], expected: l [1, 3, 5] } - log "range should create an inclusive collection of integers for the specified start and end" - assertEqual { actual: range 3 3, expected: l [3] } - assertEqual { actual: range 0 5, expected: l [0, 1, 2, 3, 4, 5] } - assertEqual { actual: range 2 (-3), expected: l [2, 1, 0, -1, -2, -3] } - log "reverse should reverse the order of items in a collection" - assertEqual { actual: r.reverse $ l [1, 2, 3], expected: l [3, 2, 1] } + assertEqual { actual: reverse (l [1, 2, 3]), expected: l [3, 2, 1] } log "singleton should construct a collection with a single value" assertEqual { actual: singleton 5, expected: l [5] } @@ -429,6 +491,18 @@ testCommon log "snoc should add an item to the end of a collection" assertEqual { actual: l [1, 2, 3] `snoc` 4, expected: l [1, 2, 3, 4] } + -- Todo - create tests for these functions + + -- some :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) + -- someRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) + + log "sort should reorder a collection into ascending order based on the result of compare" + assertEqual { actual: sort (l [1, 3, 2, 5, 6, 4]), expected: l [1, 2, 3, 4, 5, 6] } + + log "sortBy should reorder a collection into ascending order based on the result of a comparison function" + assertEqual { actual: sortBy (flip compare) $ l [1, 3, 2, 5, 6, 4] + , expected: l [6, 5, 4, 3, 2, 1] } + log "toUnfoldable should convert to any unfoldable collection" traverse_ (\xs -> assertEqual { actual: toUnfoldable (l xs), expected: xs }) [ [1] @@ -436,96 +510,55 @@ testCommon , [4,0,0,1,25,36,458,5842,23757] ] + log "transpose should swap 'rows' and 'columns' of a collection of collections" + assertEqual { actual: transpose (l [l [1,2,3], l[4,5,6], l [7,8,9]]) + , expected: l [l [1,4,7], l[2,5,8], l [3,6,9]] } + log "transpose should skip elements when row lengths don't match" + assertEqual { actual: transpose (l [l [10, 11], l [20], l [30, 31, 32]]) + , expected: l [l [10, 20, 30], l [11, 31], l [32]] } + log "union should produce the union of two collections" assertEqual { actual: union (l [1, 2, 3]) $ l [2, 3, 4], expected: l [1, 2, 3, 4] } - assertEqual { actual: union (l [1, 1, 2, 3]) $ l [2, 3, 4], expected: l [1, 1, 2, 3, 4] } + assertEqual { actual: union (l [0, 0]) $ l [1, 1], expected: l [0, 0, 1] } log "unionBy should produce the union of two collections using the specified equality relation" - assertEqual { actual: unionBy (\_ y -> y < 5) (l [1, 2, 3]) $ l [2, 3, 4, 5, 6], expected: l [1, 2, 3, 5, 6] } + assertEqual { actual: unionBy mod3eq (l [1, 5, 1, 2]) $ l [3, 4, 3, 3], expected: l [1, 5, 1, 2, 3] } log "unzip should deconstruct a collection of tuples into a tuple of collections" - assertEqual { actual: r.unzip $ l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"], expected: Tuple (l [1, 2, 3]) $ l ["a", "b", "c"] } + assertEqual { actual: unzip (l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"]), expected: Tuple (l [1, 2, 3]) $ l ["a", "b", "c"] } log "zip should use the specified function to zip two collections together" assertEqual { actual: zip (l [1, 2, 3]) $ l ["a", "b", "c"], expected: l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"] } + assertEqual { actual: zip (l [1, 2, 3]) $ l ["a", "b"], expected: l [Tuple 1 "a", Tuple 2 "b"] } + assertEqual { actual: zip (l [1, 2]) $ l ["a", "b", "c"], expected: l [Tuple 1 "a", Tuple 2 "b"] } log "zipWith should use the specified function to zip two collections together" assertEqual { actual: zipWith (\x y -> l [show x, y]) (l [1, 2, 3]) $ l ["a", "b", "c"], expected: l [l ["1", "a"], l ["2", "b"], l ["3", "c"]] } + assertEqual { actual: zipWith (\x y -> l [show x, y]) (l [1, 2, 3]) $ l ["a", "b"], expected: l [l ["1", "a"], l ["2", "b"]] } + assertEqual { actual: zipWith (\x y -> l [show x, y]) (l [1, 2]) $ l ["a", "b", "c"], expected: l [l ["1", "a"], l ["2", "b"]] } log "zipWithA should use the specified function to zip two collections together" - assertEqual { actual: zipWithA (\x y -> Just $ Tuple x y) (l [1, 2, 3]) $ l ["a", "b", "c"], expected: Just $ l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"] } - - {- - New stuff - Todo: - -- convert to assertEqual - -- sort into above - -} - - log "appendFoldable should append a foldable collection to another collection" - assertEqual { actual: appendFoldable (l [1, 2, 3]) [4, 5], expected: l [1, 2, 3, 4, 5] } - - log "insert should add an item at the appropriate place in a sorted list" - assertEqual { actual: insert 2 $ l [1, 1, 3], expected: l [1, 1, 2, 3] } - assertEqual { actual: insert 4 $ l [1, 2, 3], expected: l [1, 2, 3, 4] } - assertEqual { actual: insert 0 $ l [1, 2, 3], expected: l [0, 1, 2, 3] } - - log "insertBy should add an item at the appropriate place in a sorted collection using the specified comparison" - assertEqual { actual: insertBy (flip compare) 4 $ l [1, 2, 3], expected: l [4, 1, 2, 3] } - assertEqual { actual: insertBy (flip compare) 0 $ l [1, 2, 3], expected: l [1, 2, 3, 0] } - - log "nub should remove duplicate elements from a collection, keeping the first occurrence" - assertEqual { actual: nub (l [1, 2, 2, 3, 4, 1]), expected: l [1, 2, 3, 4] } - - log "nubBy should remove duplicate items from a collection using a supplied predicate" - assertEqual { actual: nubBy (compare `on` Array.length) $ l [[1],[2],[3,4]] , expected: l [[1],[3,4]] } - - - -- some :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) - -- someRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) - -- Todo - create tests for these functions let - todo_some = some - todo_someRec = someRec - - - log "sort should reorder a collection into ascending order based on the result of compare" - assertEqual { actual: sort (l [1, 3, 2, 5, 6, 4]), expected: l [1, 2, 3, 4, 5, 6] } - - log "sortBy should reorder a collection into ascending order based on the result of a comparison function" - assertEqual { actual: sortBy (flip compare) $ l [1, 3, 2, 5, 6, 4] - , expected: l [6, 5, 4, 3, 2, 1] } - - log "transpose should swap 'rows' and 'columns' of a collection of collections" - assertEqual { actual: transpose (l [l [1,2,3], l[4,5,6], l [7,8,9]]) - , expected: l [l [1,4,7], l[2,5,8], l [3,6,9]] } - log "transpose should skip elements when row lengths don't match" - assertEqual { actual: transpose (l [l [10, 11], l [20], l [30, 31, 32]]) - , expected: l [l [10, 20, 30], l [11, 31], l [32]] } - - -- replicate :: forall a. Int -> a -> c a - -- log "replicate should produce an list containing an item a specified number of times" - -- assertEqual { actual: replicate 3 5, expected: l [5, 5, 5] } - -- assert $ replicate 1 "foo" == l ["foo"] - -- assert $ replicate 0 "foo" == l [] - -- assert $ replicate (-1) "foo" == l [] - - {- - log "unfoldable replicate should be stack-safe" - -- even for strict lists? Possibly high memory consumption - void $ pure $ length $ replicate 100000 1 - - - -} + zipWithAFunc 0 _ = Nothing + zipWithAFunc x y = Just $ Tuple x y + assertEqual { actual: zipWithA zipWithAFunc (l [1, 2, 3]) $ l ["a", "b", "c"], expected: Just $ l [Tuple 1 "a", Tuple 2 "b", Tuple 3 "c"] } + assertEqual { actual: zipWithA zipWithAFunc (l [1, 2, 0]) $ l ["a", "b", "c"], expected: Nothing } + assertEqual { actual: zipWithA zipWithAFunc (l [1, 2, 3]) $ l ["a", "b"], expected: Just $ l [Tuple 1 "a", Tuple 2 "b"] } + assertEqual { actual: zipWithA zipWithAFunc (l [1, 2, 0]) $ l ["a", "b"], expected: Just $ l [Tuple 1 "a", Tuple 2 "b"] } + assertEqual { actual: zipWithA zipWithAFunc (l [1, 2]) $ l ["a", "b", "c"], expected: Just $ l [Tuple 1 "a", Tuple 2 "b"] } + assertEqual { actual: zipWithA zipWithAFunc (l [0, 2]) $ l ["a", "b", "c"], expected: Nothing } testCommonDiffEmptiability :: forall c cInverse canEmpty nonEmpty cPattern. Eq (c (nonEmpty Int)) => Eq (canEmpty Int) => Eq (c (c Int)) => + Eq (c Int) => Show (c (nonEmpty Int)) => Show (canEmpty Int) => Show (c (c Int)) => + Show (c Int) => + -- parameters: SkipBroken -> CommonDiffEmptiability c cInverse canEmpty nonEmpty cPattern -> Effect Unit @@ -533,79 +566,91 @@ testCommonDiffEmptiability skip { makeCollection , makeCanEmptyCollection , makeNonEmptyCollection + , makeInverseCollection , catMaybes + , cons' + , delete + , deleteBy + , difference + , dropEnd , drop , dropWhile , filter , filterM , group , groupAll + , groupAllBy , groupBy , mapMaybe , partition + , pattern + , slice + , snoc' , span + , stripPrefix , take , takeEnd , takeWhile - , cons' - , delete - , deleteBy - , difference - , dropEnd - , groupAllBy - , pattern - , slice - , snoc' - , stripPrefix } = do let - -- l :: forall f a. Foldable f => f a -> c a l = makeCollection - - -- cel :: forall f a. Foldable f => f a -> canEmpty a - -- cel = toCanEmpty <<< l - -- cel x = toCanEmpty (makeCollection x) cel = makeCanEmptyCollection - - -- nel :: forall f a. Foldable f => f a -> nonEmpty a - -- nel x = toNonEmpty (makeCollection x) nel = makeNonEmptyCollection + ivl = makeInverseCollection assertSkip :: forall a. Eq a => Show a => Array SkipBroken -> (_ -> AssertRec a) -> Effect Unit assertSkip = assertSkipHelper skip printTestType "Common (where signatures differ based on emptiability)" - -- Todo - create tests for these functions - let - todo_stripPrefix = stripPrefix - todo_snoc' = snoc' - todo_slice = slice - todo_pattern = pattern - todo_groupAllBy = groupAllBy - todo_dropEnd = dropEnd - todo_difference = difference - todo_deleteBy = deleteBy - todo_delete = delete - todo_cons' = cons' - log "catMaybes should take a collection of Maybe values and remove the Nothings" assertEqual { actual: catMaybes (l [Nothing, Just 2, Nothing, Just 4]), expected: cel [2, 4] } - log "drop should remove the specified number of items from the front of an list" - assertEqual { actual: (drop 1 (l [1, 2, 3])), expected: cel [2, 3] } - assertEqual { actual: (drop (-1) (l [1, 2, 3])), expected: cel [1, 2, 3] } - - log "dropWhile should remove all values that match a predicate from the front of an list" - assertEqual { actual: (dropWhile (_ /= 1) (l [1, 2, 3])), expected: cel [1, 2, 3] } - assertEqual { actual: (dropWhile (_ /= 2) (l [1, 2, 3])), expected: cel [2, 3] } - --assert $ (dropWhile (_ /= 1) nil) == nil + log "cons' should create a collection by prepending an element to an 'inverse' (can-empty or not) collection" + assertEqual { actual: cons' 1 $ ivl [2, 3], expected: l [1, 2, 3] } + + log "delete should remove the first matching item from a collection" + assertEqual { actual: delete 1 $ l [1, 2, 1], expected: cel [2, 1] } + assertEqual { actual: delete 2 $ l [1, 2, 1], expected: cel [1, 1] } + assertEqual { actual: delete 3 $ l [1, 2, 1], expected: cel [1, 2, 1] } + assertEqual { actual: delete 2 $ l [2], expected: cel [] } + + log "deleteBy should remove the first equality-relation-matching item from a collection" + assertEqual { actual: deleteBy (/=) 2 $ l [1, 2, 1], expected: cel [2, 1] } + assertEqual { actual: deleteBy (/=) 1 $ l [1, 2, 1], expected: cel [1, 1] } + assertEqual { actual: deleteBy (/=) 1 $ l [1, 1, 1], expected: cel [1, 1, 1] } + assertEqual { actual: deleteBy (/=) 1 $ l [2], expected: cel [] } + + log "difference (\\\\) should return the 'difference' between two collections" + assertEqual { actual: l [1, 2, 3, 4, 3, 2] `difference` l [1], expected: cel [2,3,4,3,2] } + assertEqual { actual: l [1, 2, 3, 4, 3, 2] `difference` l [2], expected: cel [1,3,4,3,2] } + assertEqual { actual: l [1, 2, 3, 4, 3, 2] `difference` l [2, 2], expected: cel [1,3,4,3] } + assertEqual { actual: l [1, 2, 3, 4, 3, 2] `difference` l [2, 2, 2], expected: cel [1,3,4,3] } + assertEqual { actual: l [1, 2, 3] `difference` l [3, 1, 2], expected: cel [] } + + log "drop should remove the specified number of items from the front of a collection" + assertEqual { actual: drop 1 $ l [1, 2, 3], expected: cel [2, 3] } + assertEqual { actual: drop (-1) $ l [1, 2, 3], expected: cel [1, 2, 3] } + + log "dropEnd should remove the specified number of items from the end of a collection" + assertEqual { actual: dropEnd (-1) $ l [1, 2, 3], expected: cel [1, 2, 3] } + assertEqual { actual: dropEnd 0 $ l [1, 2, 3], expected: cel [1, 2, 3] } + assertEqual { actual: dropEnd 1 $ l [1, 2, 3], expected: cel [1, 2] } + assertEqual { actual: dropEnd 2 $ l [1, 2, 3], expected: cel [1] } + assertEqual { actual: dropEnd 3 $ l [1, 2, 3], expected: cel [] } + assertEqual { actual: dropEnd 4 $ l [1, 2, 3], expected: cel [] } + + log "dropWhile should remove all values that match a predicate from the front of a collection" + assertEqual { actual: dropWhile (_ /= 1) $ l [1, 2, 3], expected: cel [1, 2, 3] } + assertEqual { actual: dropWhile (_ /= 2) $ l [1, 2, 3], expected: cel [2, 3] } -- Surprised this does not work with $ -- let l10 = l $ Array.range 0 10 let l10 = l (Array.range 0 10) + -- More discussion here: + -- https://discourse.purescript.org/t/apply-is-not-always-a-valid-substitute-for-parens/2301 log "filter should remove items that don't match a predicate" assertEqual { actual: filter odd l10, expected: cel [1, 3, 5, 7, 9] } @@ -614,196 +659,696 @@ testCommonDiffEmptiability skip assertEqual { actual: filterM (Just <<< odd) l10, expected: Just $ cel [1, 3, 5, 7, 9] } assertEqual { actual: filterM (const Nothing) l10, expected: Nothing } + log "group should group consecutive equal elements into collections" + assertEqual { actual: group (l [1, 2, 2, 3, 3, 3, 1]) + , expected: l [nel [1], nel [2, 2], nel [3, 3, 3], nel [1]] } - log "group should group consecutive equal elements into lists" - assertEqual { actual: group (l [1, 2, 2, 3, 3, 3, 1]), expected: l [nel [1], nel [2, 2], nel [3, 3, 3], nel [1]] } - - log "groupAll should group equal elements into lists" + log "groupAll should group equal elements into collections" assertSkip [SkipBrokenLazyCanEmpty] \_ -> { actual: groupAll (l [1, 2, 2, 3, 3, 3, 1]), expected: l [nel [1, 1], nel [2, 2], nel [3, 3, 3]] } - --assert $ groupAll (l [1, 2, 2, 3, 3, 3, 1]) == l [nel [1, 1], nel [2, 2], nel [3, 3, 3]] - log "groupBy should group consecutive equal elements into lists based on an equivalence relation" - assertEqual { actual: groupBy (eq `on` (_ `mod` 10)) (l [1, 2, 12, 3, 13, 23, 11]), expected: l [nel [1], nel [2, 12], nel [3, 13, 23], nel [11]] } + log "groupAllBy should sort then group equal elements into lists based on a comparison function" + assertEqual { actual: groupAllBy (compare `on` (_ `div` 10)) $ l [32, 31, 21, 22, 11, 33] + , expected: l [nel [11], nel [21, 22], nel [32, 31, 33]] } + + log "groupBy should group consecutive equal elements into collections based on an equivalence relation" + assertEqual { actual: groupBy (eq `on` (_ `mod` 10)) $ l [1, 2, 12, 3, 13, 23, 11] + , expected: l [nel [1], nel [2, 12], nel [3, 13, 23], nel [11]] } + + log "mapMaybe should transform every item in a collection, throwing out Nothing values" + assertEqual { actual: mapMaybe (\x -> if x /= 0 then Just x else Nothing) $ l [0, 1, 0, 0, 2, 3] + , expected: cel [1, 2, 3] } + + log "partition should separate a collection into a tuple of collections that do and do not satisfy a predicate" + assertEqual { actual: partition (_ > 2) $ l [1, 5, 3, 2, 4] + , expected: { yes: cel [5, 3, 4], no: cel [1, 2] } } + + + log "slice should extract a sub-collection by an inclusive start and exclusive end index" + let nums = l [0, 1, 2, 3, 4] + assertEqual { actual: slice 1 3 nums, expected: cel [1, 2] } + + log "slice should make best effort for out-of-bounds (but intersecting) indices" + assertEqual { actual: slice 3 7 nums, expected: cel [3, 4] } + -- assertEqual { actual: slice (-2) 3 nums, expected: cel [1, 2] } -- Todo - broken, returns full collection + + log "slice should return an empty collection if indices do not intersect with available elements" + assertEqual { actual: slice 5 7 nums, expected: cel [] } - -- todo - wait for this to be reworked - -- log "groupAllBy should group equal elements into lists based on an comparison function" - --assertEqual { actual: groupAllBy (compare `on` mod 10) (l [1, 2, 12, 3, 13, 23, 11]), expected: l [nel [1, 11], nel [2, 12], nel [3, 13, 23]] } + log "slice should return an empty collection if indices are not incrementing" + assertEqual { actual: slice 3 1 nums, expected: cel [] } - log "mapMaybe should transform every item in an list, throwing out Nothing values" - assertEqual { actual: mapMaybe (\x -> if x /= 0 then Just x else Nothing) (l [0, 1, 0, 0, 2, 3]), expected: cel [1, 2, 3] } - log "partition should separate a list into a tuple of lists that do and do not satisfy a predicate" - let partitioned = partition (_ > 2) (l [1, 5, 3, 2, 4]) - assertEqual { actual: partitioned.yes, expected: cel [5, 3, 4] } - assertEqual { actual: partitioned.no, expected: cel [1, 2] } + log "snoc' should create a collection by appending an element to an 'inverse' (can-empty or not) collection" + assertEqual { actual: snoc' (ivl [1, 2]) 3, expected: l [1, 2, 3] } - log "span should split an list in two based on a predicate" - let spanResult = span (_ < 4) (l [1, 2, 3, 4, 5, 6, 7]) - assertEqual { actual: spanResult.init, expected: cel [1, 2, 3] } - assertEqual { actual: spanResult.rest, expected: cel [4, 5, 6, 7] } + log "span should split a collection in two based on a predicate" + assertEqual { actual: span (_ < 4) $ l [1, 2, 3, 4, 5, 6, 1] + , expected: { init: cel [1, 2, 3], rest: cel [4, 5, 6, 1] } } + assertEqual { actual: span (_ < 4) $ l [9, 2, 3, 4, 5, 6, 1] + , expected: { init: cel [], rest: cel [9, 2, 3, 4, 5, 6, 1] } } - log "take should keep the specified number of items from the front of an list, discarding the rest" - assertEqual { actual: (take 1 (l [1, 2, 3])), expected: cel [1] } - assertEqual { actual: (take 2 (l [1, 2, 3])), expected: cel [1, 2] } - --assert $ (take 1 nil) == nil - assertEqual { actual: (take 0 (l [1, 2])), expected: cel [] } - assertEqual { actual: (take (-1) (l [1, 2])), expected: cel [] } + log "stripPrefix should remove elements matching a pattern from the start of a collection" + assertEqual { actual: stripPrefix (pattern (l [4, 2])) $ l [4, 2, 5, 1] , expected: Just $ cel [5, 1] } + assertEqual { actual: stripPrefix (pattern (l [4, 2])) $ l [4, 2] , expected: Just $ cel [] } - log "takeEnd should keep the specified number of items from the end of an list, discarding the rest" + log "stripPrefix should return nothing if starting elements do not match pattern" + assertEqual { actual: stripPrefix (pattern (l [4, 2])) $ l [4, 4, 2, 5, 1] , expected: Nothing } + assertEqual { actual: stripPrefix (pattern (l [4, 2])) $ l [4] , expected: Nothing } + + log "take should keep the specified number of items from the front of a collection, discarding the rest" + assertEqual { actual: take 1 $ l [1, 2, 3], expected: cel [1] } + assertEqual { actual: take 2 $ l [1, 2, 3], expected: cel [1, 2] } + assertEqual { actual: take 0 $ l [1, 2], expected: cel [] } + assertEqual { actual: take (-1) $ l [1, 2], expected: cel [] } + + log "takeEnd should keep the specified number of items from the end of a collection, discarding the rest" assertSkip [SkipBrokenLazyCanEmpty] - \_ -> { actual: takeEnd 1 (l [1, 2, 3]), expected: cel [3] } + \_ -> { actual: takeEnd 1 $ l [1, 2, 3], expected: cel [3] } assertSkip [SkipBrokenLazyCanEmpty] - \_ -> { actual: takeEnd 2 (l [1, 2, 3]), expected: cel [2, 3] } + \_ -> { actual: takeEnd 2 $ l [1, 2, 3], expected: cel [2, 3] } assertSkip [SkipBrokenLazyCanEmpty] - \_ -> { actual: takeEnd 2 (l [1]), expected: cel [1] } + \_ -> { actual: takeEnd 2 $ l [1], expected: cel [1] } - --assert $ (takeEnd 1 (l [1, 2, 3])) == cel [3] - --assert $ (takeEnd 2 (l [1, 2, 3])) == cel [2, 3] - ----assert $ (takeEnd 1 nil) == nil - --assert $ (takeEnd 2 (l [1])) == cel [1] + log "takeWhile should keep all values that match a predicate from the front of a collection" + assertEqual { actual: takeWhile (_ /= 2) $ l [1, 2, 3], expected: cel [1] } + assertEqual { actual: takeWhile (_ /= 3) $ l [1, 2, 3], expected: cel [1, 2] } - log "takeWhile should keep all values that match a predicate from the front of an list" - assertEqual { actual: (takeWhile (_ /= 2) (l [1, 2, 3])), expected: cel [1] } - assertEqual { actual: (takeWhile (_ /= 3) (l [1, 2, 3])), expected: cel [1, 2] } - --assert $ (takeWhile (_ /= 1) nil) == nil - -testOnlyCanEmpty :: forall c nonEmpty. +testOnlyCanEmpty :: forall c nonEmpty cPattern. + -- OnlyCanEmpty API Alternative c => MonadPlus c => MonadZero c => Monoid (c Int) => Plus c => Unfoldable c => - -- + -- Common API with additional canEmpty tests + Alt c => + Apply c => + Bind c => + Extend c => + Foldable c => + FoldableWithIndex Int c => + Functor c => + FunctorWithIndex Int c => + Monad c => + Ord (c Int) => + Ord1 c => + Semigroup (c Int) => + Traversable c => + TraversableWithIndex Int c => + -- Constraints for unit test asserts Eq (c Int) => Eq (c (nonEmpty Int)) => + Eq (c (c Int)) => + Eq (c (c String)) => + Eq (c (Array Int)) => + Eq (c (Tuple Int String)) => Show (c Int) => Show (c (nonEmpty Int)) => - OnlyCanEmpty c nonEmpty -> Effect Unit -testOnlyCanEmpty - r@{ makeCollection - , makeNonEmptyCollection + Show (c (c Int)) => + Show (c (c String)) => + Show (c (Array Int)) => + Show (c (Tuple Int String)) => + -- parameters: + SkipBroken -> + OnlyCanEmpty c -> + Common c -> + CommonDiffEmptiability c nonEmpty c nonEmpty cPattern -> + Effect Unit +testOnlyCanEmpty skip + -- OnlyCanEmpty + { makeCollection + + -- Only available for CanEmpty collections + , null + , many + , manyRec + + -- Todo - can these be deduplicated into diff-empty using Maybe / identity constructor? + -- Can't be deduplicated from NonEmpty collections due to use of Maybe , fromFoldable , head , init , last , tail , uncons + } - , null - , many - , manyRec - } = do - let - l = makeCollection - nel = makeNonEmptyCollection - - nil :: c Int - nil = l [] - - printTestType "Only canEmpty" - - -- ======= Typeclass tests ======== - - -- Alternative - -- applicative and plus - -- (f <|> g) <*> x == (f <*> x) <|> (g <*> x) - -- empty <*> f == empty - - -- MonadPlus - -- Additional law on MonadZero - -- (x <|> y) >>= f == (x >>= f) <|> (y >>= f) - - -- MonadZero - -- monad and alternative - -- empty >>= f = empty - - -- Monoid - -- mempty :: c - log "mempty should not change the collection it is appended to" - assertEqual { actual: l [5] <> mempty, expected: l [5] } - log "mempty should be an empty collection" - assertEqual { actual: l [], expected: (mempty :: c Int) } - - -- Plus - -- empty :: forall a. c a - log "empty should create an empty collection" - assertEqual { actual: l [], expected: (empty :: c Int) } - - -- Unfoldable - -- unfoldr :: forall a b. (b -> Maybe (Tuple a b)) -> b -> c a + -- Test these common functions again with empty collections: - log "unfoldr should maintain order" - let + -- Common + { appendFoldable + , concat + , concatMap + , cons + , elemIndex + , elemLastIndex + , findIndex + , findLastIndex + , foldM + , index + , insert + , insertBy + , intersect + , intersectBy + , length + , nub + , nubBy + , nubEq + , nubByEq + , reverse + , singleton + , snoc + , some + , someRec + , sort + , sortBy + , toUnfoldable + , transpose + , union + , unionBy + , unzip + , zip + , zipWith + , zipWithA + } + + -- CommonDiffEmptiability + { catMaybes + -- , cons' -- tested in onlyNonEmpty + , delete + , deleteBy + , difference + , dropEnd + , drop + , dropWhile + , filter + , filterM + , group + , groupAll + , groupAllBy + , groupBy + , mapMaybe + , partition + , pattern + , slice + -- , snoc' -- tested in onlyNonEmpty + , span + , stripPrefix + , take + , takeEnd + , takeWhile + } = do + let + l = makeCollection + + nil :: c Int + nil = l [] + + assertSkip :: forall a. Eq a => Show a => Array SkipBroken -> (_ -> AssertRec a) -> Effect Unit + assertSkip = assertSkipHelper skip + + printTestType "Only canEmpty" + + -- ======= Typeclass tests ======== + + -- Alternative + -- applicative and plus + -- (f <|> g) <*> x == (f <*> x) <|> (g <*> x) + -- empty <*> x == empty + + log "Alternative's laws should be upheld" + do -- limit scope for helper variables + let + f = l [mul 10] + g = l [mul 100] + x = l [1, 2, 3] + + -- Todo - likely broken for some list types until Apply is fixed + + assertEqual { actual: (f <|> g) <*> x, expected: (f <*> x) <|> (g <*> x) } + assertEqual { actual: (f <|> g) <*> x, expected: l [10, 20, 30, 100, 200, 300] } + assertEqual { actual: empty <*> x, expected: empty :: c Int } + + do -- limit scope for helper variable + let + f x = l [x, 10 + x] + + -- MonadZero + -- monad and alternative + -- empty >>= f = empty + log "MonadZero's law should be upheld" + assertEqual { actual: empty >>= f, expected: empty :: c Int } + + -- MonadPlus + -- Additional law on MonadZero + -- (x <|> y) >>= f == (x >>= f) <|> (y >>= f) + log "MonadPlus's law should be upheld" + let + x = l [1, 2] + y = l [3, 4] + assertEqual { actual: (x <|> y) >>= f, expected: (x >>= f) <|> (y >>= f) } + assertEqual { actual: (x <|> y) >>= f, expected: l [1,11,2,12,3,13,4,14] } + + -- Monoid + -- mempty :: c + + log "Monoid's mempty should be an empty collection" + assertEqual { actual: mempty :: c Int, expected: nil } + + log "Monoid's mempty should not change the collection it is appended to" + do -- limit scope for helper variable + let x = l [1, 2, 3] + assertEqual { actual: x <> mempty, expected: x } + assertEqual { actual: mempty <> x, expected: x } + + -- Plus + -- empty :: forall a. c a + + log "Plus's empty should be an empty collection" + assertEqual { actual: empty :: c Int, expected: nil } + + log "Plus's empty should not change the collection it is `alt`-ed (concatenated) with" + do -- limit scope for helper variable + let x = l [1, 2, 3] + assertEqual { actual: x <|> empty, expected: x } + assertEqual { actual: empty <|> x, expected: x } + + log "Plus's empty should remain unchanged when mapped over" + assertEqual { actual: (add 1) <$> empty, expected: empty :: c Int } + + + -- Unfoldable + -- unfoldr :: forall a b. (b -> Maybe (Tuple a b)) -> b -> c a + + let step :: Int -> Maybe (Tuple Int Int) step n = if n > 5 then Nothing else Just $ Tuple n $ n + 1 + log "Unfoldable's unfoldr should maintain order" assertEqual { actual: unfoldr step 1, expected: l [1, 2, 3, 4, 5] } + log "Unfoldable's replicate should be correct" + assertEqual { actual: Unfoldable.replicate 3 1, expected: l [1, 1, 1] } + assertEqual { actual: Unfoldable.replicate 1 1, expected: l [1] } + assertEqual { actual: Unfoldable.replicate 0 1, expected: nil } + assertEqual { actual: Unfoldable.replicate (-1) 1, expected: nil } + log "Unfoldable's replicate should be stack-safe" - void $ pure $ r.last $ (Unfoldable.replicate 100000 1 :: c Int) + assertEqual { actual: last (Unfoldable.replicate 100000 1), expected: Just 1 } -- ======= Functions tests ======== - -- Todo tests for these functions - let - todo_null = null - todo_manyRec = manyRec - todo_many = many - todo_fromFoldable = fromFoldable + -- These functions are not available for non-empty collections + log "null should return true if collection is empty" + assertTrue $ null nil + assertFalse $ null (l [1]) + assertFalse $ null (l [1, 2]) + + -- Todo - tests for these functions + -- many :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) + -- manyRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) - --fromFoldable :: forall f. Foldable f => f ~> c - --already extensively checked in common tests -- These are the remaining functions that can't be deduplicated due to use of Maybe - -- Todo - double-check the phrasing on these? Might be confusing to refer to a + log "fromFoldable should create a collection from another foldable collection" + assertEqual { actual: fromFoldable [1, 2], expected: l [1, 2] } + assertEqual { actual: fromFoldable [], expected: nil } + assertEqual { actual: fromFoldable (Just 1), expected: l [1] } + assertEqual { actual: fromFoldable Nothing, expected: nil } + + -- Todo - Is this good phrasing? Might be confusing to refer to a -- non-empty canEmpty list. - log "head should return a Just-NEL.NonEmptyListped first value of a non-empty list" + log "head should return the first item of a non-empty collection" assertEqual { actual: head (l [1, 2]), expected: Just 1 } - log "head should return Nothing for an empty list" + log "head should return Nothing for an empty collection" assertEqual { actual: head nil, expected: Nothing } - -- Todo - phrasing should be changed to note all but last (not all but first). - log "init should return a Just-NEL.NonEmptyListped list containing all the items in an list apart from the first for a non-empty list" - assertEqual { actual: init (l [1, 2, 3]), expected: Just (l [1, 2]) } - log "init should return Nothing for an empty list" + log "init should drop the last item of a non-empty collection" + assertEqual { actual: init (l [1, 2, 3]), expected: Just $ l [1, 2] } + + log "init should return Nothing for an empty collection" assertEqual { actual: init nil, expected: Nothing } - log "last should return a Just-NEL.NonEmptyListped last value of a non-empty list" + log "last should return the last item of a non-empty collection" assertEqual { actual: last (l [1, 2]), expected: Just 2 } - log "last should return Nothing for an empty list" + log "last should return Nothing for an empty collection" assertEqual { actual: last nil, expected: Nothing } - log "tail should return a Just-NEL.NonEmptyListped list containing all the items in an list apart from the first for a non-empty list" - assertEqual { actual: tail (l [1, 2, 3]), expected: Just (l [2, 3]) } + log "tail should drop the first item of a non-empty collection" + assertEqual { actual: tail (l [1, 2, 3]), expected: Just $ l [2, 3] } - log "tail should return Nothing for an empty list" + log "tail should return Nothing for an empty collection" assertEqual { actual: tail nil, expected: Nothing } - log "uncons should return nothing when used on an empty list" - assertEqual { actual: isNothing (uncons nil), expected: true } + log "uncons should split a non-empty collection into a head and tail record" + assertEqual { actual: uncons (l [1]), expected: Just { head: 1, tail: nil } } + assertEqual { actual: uncons (l [1, 2, 3]), expected: Just { head: 1, tail: l [2, 3] } } + + log "uncons should return nothing for an empty collection" + assertEqual { actual: uncons nil, expected: Nothing } + + + -- ========== Common API with additional canEmpty tests ========== + + log "Ensure common functions work with empty collections" + + -- ===== Common Typeclasses ===== + + -- Alt + -- alt :: forall a. f a -> f a -> f a + log "Alt's alt (<|>) should work with empty collections" + assertEqual { actual: l [1,2] <|> nil, expected: l [1,2] } + assertEqual { actual: nil <|> l [3,4], expected: l [3,4] } + assertEqual { actual: nil <|> nil, expected: nil } + + -- Apply + -- apply :: forall a b. f (a -> b) -> f a -> f b + log "Apply's apply (<*>) should work with empty collections" + assertEqual { actual: l [] <*> l [1, 2, 3], expected: nil } + assertEqual { actual: l [mul 10, mul 100] <*> nil, expected: nil } + + -- Bind c + -- bind :: forall a b. m a -> (a -> m b) -> m b + log "Bind's bind (>>=) should work with empty collections" + assertEqual { actual: nil >>= \x -> l [x,10+x], expected: nil } + assertEqual { actual: l [1,2,3] >>= \_ -> nil, expected: nil } + + -- Extend + -- extend :: forall b a. (w a -> b) -> w a -> w b + log "Extend's extend (<<=) should work with empty collections" + assertEqual { actual: sum <<= nil, expected: nil } + + -- Foldable + -- foldr :: forall a b. (a -> b -> b) -> b -> f a -> b + -- foldl :: forall a b. (b -> a -> b) -> b -> f a -> b + -- foldMap :: forall a m. Monoid m => (a -> m) -> f a -> m + + log "Foldable's foldl should work with empty collections" + assertEqual { actual: foldl (\b a -> b * 10 + a) 0 nil, expected: 0 } + + log "Foldable's foldr should work with empty collections" + assertEqual { actual: foldr (\a b -> b * 10 + a) 0 nil, expected: 0 } + + log "Foldable's foldMap should work with empty collections" + assertEqual { actual: foldMap show nil, expected: "" } + + -- FoldableWithIndex + -- foldrWithIndex :: forall a b. (i -> a -> b -> b) -> b -> f a -> b + -- foldlWithIndex :: forall a b. (i -> b -> a -> b) -> b -> f a -> b + -- foldMapWithIndex :: forall a m. Monoid m => (i -> a -> m) -> f a -> m + + log "FoldableWithIndex's foldlWithIndex should work with empty collections" + assertEqual { actual: foldlWithIndex (\_ b a -> b * 10 + a) 0 nil, expected: 0 } + + log "FoldableWithIndex's foldrWithIndex should work with empty collections" + assertEqual { actual: foldrWithIndex (\_ a b -> b * 10 + a) 0 nil, expected: 0 } + + log "FoldableWithIndex's foldMapWithIndex should work with empty collections" + assertEqual { actual: foldMapWithIndex (\_ a -> show a) nil, expected: "" } + + -- Functor + -- map :: forall a b. (a -> b) -> f a -> f b + log "Functor's map should work with empty collections" + assertEqual { actual: map (add 1) nil, expected: nil } + + -- FunctorWithIndex + -- mapWithIndex :: forall a b. (i -> a -> b) -> f a -> f b + + log "FunctorWithIndex's mapWithIndex should work with empty collections" + assertEqual { actual: mapWithIndex add nil, expected: nil } + + -- Ord + -- compare :: a -> a -> Ordering + log "Ord's compare should work with empty collections" + assertEqual { actual: compare nil nil, expected: EQ } + assertEqual { actual: compare nil (l [1]), expected: LT } + assertEqual { actual: compare (l [1]) nil, expected: GT } + + -- Ord1 + -- compare1 :: forall a. Ord a => f a -> f a -> Ordering + log "Ord1's compare1 should work with empty collections" + assertEqual { actual: compare1 nil nil, expected: EQ } + assertEqual { actual: compare1 nil (l [1]), expected: LT } + assertEqual { actual: compare1 (l [1]) nil, expected: GT } + + -- Semigroup + -- append :: a -> a -> a + + log "Semigroup's append (<>) should work with empty collections" + assertEqual { actual: l [1,2] <> nil, expected: l [1,2] } + assertEqual { actual: nil <> l [3,4], expected: l [3,4] } + assertEqual { actual: nil <> nil, expected: nil } + + -- Traversable + -- traverse :: forall a b m. Applicative m => (a -> m b) -> t a -> m (t b) + -- sequence :: forall a m. Applicative m => t (m a) -> m (t a) + + let + safeDiv :: Int -> Int -> Maybe Int + safeDiv _ 0 = Nothing + safeDiv n d = Just $ n / d + + log "Traversable's traverse should work with empty collections" + assertEqual { actual: traverse (safeDiv 12) nil, expected: Just nil } + + log "Traversable's sequence should work with empty collections" + assertEqual { actual: sequence (l []), expected: Just nil } + + -- TraversableWithIndex + -- traverseWithIndex :: forall a b m. Applicative m => (i -> a -> m b) -> t a -> m (t b) + + log "TraversableWithIndex's traverseWithIndex should work with empty collections" + assertEqual { actual: traverseWithIndex safeDiv nil, expected: Just nil } + + + -- ===== Common Functions ===== + + log "appendFoldable should work with empty collections" + assertEqual { actual: appendFoldable nil [4, 5], expected: l [4, 5] } + assertEqual { actual: appendFoldable nil [], expected: nil } + + log "concat should work with empty collections" + assertEqual { actual: concat (l []), expected: nil } + assertEqual { actual: concat (l [nil]), expected: nil } + assertEqual { actual: concat (l [nil, l [1, 2], nil, l [3, 4], nil]), expected: l [1, 2, 3, 4] } + + let + doubleAndOrig :: Int -> c Int + doubleAndOrig x = cons (x * 2) $ singleton x + + log "concatMap should work with empty collections" + assertEqual { actual: concatMap doubleAndOrig nil, expected: nil } + + log "cons should work with empty collections" + assertEqual { actual: cons 1 nil, expected: l [1] } + + log "elemIndex should work with empty collections" + assertEqual { actual: elemIndex 1 nil, expected: Nothing } + + log "elemLastIndex should work with empty collections" + assertEqual { actual: elemLastIndex 1 nil, expected: Nothing } + + log "findIndex should work with empty collections" + assertEqual { actual: findIndex (_ /= 1) nil, expected: Nothing } + + log "findLastIndex should work with empty collections" + assertEqual { actual: findLastIndex (_ /= 1) nil, expected: Nothing } - log "uncons should split an list into a head and tail record when there is at least one item" - assertEqual { actual: uncons (l [1]), expected: Just {head: 1, tail: l []} } - assertEqual { actual: uncons (l [1, 2, 3]), expected: Just {head: 1, tail: l [2, 3]} } + log "foldM should work with empty collections" + assertEqual { actual: foldM (\x y -> Just $ x + y) 0 nil, expected: Just 0 } + log "index (!!) should work with empty collections" + assertEqual { actual: nil `index` 0, expected: Nothing } + log "insert should work with empty collections" + assertEqual { actual: insert 2 nil, expected: l [2] } + log "insertBy should work with empty collections" + assertEqual { actual: insertBy (flip compare) 4 nil, expected: l [4] } + log "intersect should work with empty collections" + assertEqual { actual: intersect nil $ l [1, 1, 2, 3], expected: nil } + assertEqual { actual: intersect (l [1, 2, 3, 4, 3, 2, 1]) nil, expected: nil } + assertEqual { actual: intersect nil nil, expected: nil } -testOnlyNonEmpty :: forall c canEmpty. + log "intersectBy should work with empty collections" + assertEqual { actual: intersectBy (\x y -> x * 2 == y) nil $ l [2, 6], expected: nil } + assertEqual { actual: intersectBy (\x y -> x * 2 == y) (l [1, 2, 3]) nil, expected: nil } + assertEqual { actual: intersectBy (\x y -> x * 2 == y) nil nil, expected: nil } + + log "length should work with empty collections" + assertEqual { actual: length nil, expected: 0 } + + log "nub should work with empty collections" + assertEqual { actual: nub nil, expected: nil } + + log "nubBy should work with empty collections" + assertEqual { actual: nubBy (compare `on` Array.length) $ l [], expected: l [] :: _ (_ Int) } + + log "nubEq should work with empty collections" + assertEqual { actual: nubEq nil, expected: nil } + + log "nubByEq should work with empty collections" + let mod3eq = eq `on` \n -> mod n 3 + assertEqual { actual: nubByEq mod3eq nil, expected: nil } + + log "reverse should work with empty collections" + assertEqual { actual: reverse nil, expected: nil } + + log "snoc should work with empty collections" + assertEqual { actual: nil `snoc` 4, expected: l [4] } + + -- Todo - create tests for these functions + + -- some :: forall f a. Alternative f => Lazy (f (c a)) => f a -> f (c a) + -- someRec :: forall f a. MonadRec f => Alternative f => f a -> f (c a) + + log "sort should work with empty collections" + assertEqual { actual: sort nil, expected: nil } + + log "sortBy should work with empty collections" + assertEqual { actual: sortBy (flip compare) nil, expected: nil } + + log "toUnfoldable should work with empty collections" + assertEqual { actual: toUnfoldable nil, expected: [] } + + log "transpose should work with empty collections" + assertEqual { actual: transpose (l [l [10, 11], nil, l [30, 31, 32]]) + , expected: l [l [10, 30], l [11, 31], l [32]] } + assertEqual { actual: transpose (l [] :: _ (_ Int)), expected: l []} + + log "union should work with empty collections" + assertEqual { actual: union nil $ l [1, 1], expected: l [1] } + assertEqual { actual: union (l [0, 0]) nil, expected: l [0, 0] } + assertEqual { actual: union nil nil, expected: nil } + + log "unionBy should work with empty collections" + assertEqual { actual: unionBy mod3eq nil $ l [3, 4, 3, 3], expected: l [3, 4] } + assertEqual { actual: unionBy mod3eq (l [1, 5, 1, 2]) nil, expected: l [1, 5, 1, 2] } + assertEqual { actual: unionBy mod3eq nil nil, expected: nil } + + log "unzip should work with empty collections" + assertEqual { actual: unzip (l []), expected: Tuple nil nil } + + log "zip should work with empty collections" + assertEqual { actual: zip nil $ l ["a", "b", "c"], expected: l [] } + assertEqual { actual: zip (l [1, 2, 3]) (l [] :: _ String), expected: l [] } + assertEqual { actual: zip nil (l [] :: _ String), expected: l []} + + log "zipWith should work with empty collections" + assertEqual { actual: zipWith (\x y -> l [show x, y]) nil $ l ["a", "b", "c"], expected: l [] } + assertEqual { actual: zipWith (\x y -> l [show x, y]) (l [1, 2, 3]) $ l [], expected: l [] } + assertEqual { actual: zipWith (\x y -> l [show x, y]) nil $ l [], expected: l [] } + + log "zipWithA should work with empty collections" + let + zipWithAFunc 0 _ = Nothing + zipWithAFunc x y = Just $ Tuple x y + assertEqual { actual: zipWithA zipWithAFunc nil $ l ["a", "b", "c"], expected: Just $ l [] } + assertEqual { actual: zipWithA zipWithAFunc (l [1, 2, 3]) $ l [], expected: Just $ l [] } + assertEqual { actual: zipWithA zipWithAFunc (l [1, 2, 0]) $ l [], expected: Just $ l [] } + assertEqual { actual: zipWithA zipWithAFunc nil $ l [], expected: Just $ l [] } + + -- ===== CommonDiffEmptiability Functions ===== + + log "catMaybes should work with empty collections" + assertEqual { actual: catMaybes (l []), expected: nil } + + log "delete should work with empty collections" + assertEqual { actual: delete 3 nil, expected: nil } + + log "deleteBy should work with empty collections" + assertEqual { actual: deleteBy (/=) 1 nil, expected: nil } + + log "difference (\\\\) should work with empty collections" + assertEqual { actual: l [1, 2, 3, 4, 3, 2] `difference` nil, expected: l [1, 2, 3, 4, 3, 2] } + assertEqual { actual: nil `difference` l [1, 2], expected: nil } + assertEqual { actual: nil `difference` nil, expected: nil } + + log "drop should work with empty collections" + assertEqual { actual: drop 1 nil, expected: nil } + assertEqual { actual: drop (-1) nil, expected: nil } + + log "dropEnd should work with empty collections" + assertEqual { actual: dropEnd 1 nil, expected: nil } + assertEqual { actual: dropEnd 1 nil, expected: nil } + + log "dropWhile should work with empty collections" + assertEqual { actual: dropWhile (_ /= 1) nil, expected: nil } + + log "filter should work with empty collections" + assertEqual { actual: filter odd nil, expected: nil } + + log "filterM should work with empty collections" + assertEqual { actual: filterM (Just <<< odd) nil, expected: Just $ l [] } + assertEqual { actual: filterM (const Nothing) nil, expected: Just $ l [] } + + log "group should work with empty collections" + assertEqual { actual: group nil, expected: l [] } + + log "groupAll should work with empty collections" + assertSkip [SkipBrokenLazyCanEmpty] + \_ -> { actual: groupAll nil, expected: l [] } + + log "groupAllBy should work with empty collections" + assertEqual { actual: groupAllBy (compare `on` (_ `div` 10)) nil, expected: l [] } + + log "groupBy should work with empty collections" + assertEqual { actual: groupBy (eq `on` (_ `mod` 10)) nil, expected: l [] } + + log "mapMaybe should work with empty collections" + assertEqual { actual: mapMaybe (\x -> if x /= 0 then Just x else Nothing) nil, expected: nil } + + log "partition should work with empty collections" + assertEqual { actual: partition (_ > 2) nil, expected: { yes: nil, no: nil } } + + log "slice should work with empty collections" + assertEqual { actual: slice 1 3 nil, expected: nil } + assertEqual { actual: slice (-2) 3 nil, expected: nil } + + log "span should work with empty collections" + assertEqual { actual: span (_ < 4) nil, expected: { init: nil, rest: nil } } + + log "stripPrefix should work with empty collections" + assertEqual { actual: stripPrefix (pattern nil) $ l [4, 2, 5, 1] , expected: Just $ l [4, 2, 5, 1] } + assertEqual { actual: stripPrefix (pattern (l [4, 2])) nil , expected: Nothing } + assertEqual { actual: stripPrefix (pattern nil) nil , expected: Just nil } + + log "take should work with empty collections" + assertEqual { actual: take 1 nil, expected: nil } + assertEqual { actual: take 0 nil, expected: nil } + assertEqual { actual: take (-1) nil, expected: nil } + + log "takeEnd should work with empty collections" + assertSkip [SkipBrokenLazyCanEmpty] + \_ -> { actual: takeEnd 1 nil, expected: nil } + assertSkip [SkipBrokenLazyCanEmpty] + \_ -> { actual: takeEnd 0 nil, expected: nil } + assertSkip [SkipBrokenLazyCanEmpty] + \_ -> { actual: takeEnd (-1) nil, expected: nil } + + log "takeWhile should work with empty collections" + assertEqual { actual: takeWhile (_ /= 2) nil, expected: nil } + + +-- Todo - test can-empty versions of common lazy functions + + + +testOnlyNonEmpty :: forall c canEmpty cPattern. Comonad c => --, Foldable1 c => -- missing from LazyNonEmptyList --, Traversable1 c => -- missing from LazyNonEmptyList @@ -811,29 +1356,40 @@ testOnlyNonEmpty :: forall c canEmpty. Eq (canEmpty Int) => Show (c Int) => Show (canEmpty Int) => - OnlyNonEmpty c canEmpty -> Effect Unit + -- parameters: + OnlyNonEmpty c canEmpty -> + CommonDiffEmptiability c canEmpty canEmpty c cPattern -> + Effect Unit testOnlyNonEmpty - r@{ makeCollection + { makeCollection , makeCanEmptyCollection + -- Only available for NonEmpty collections + , fromList + , toList + -- Todo, should there be a `toUnfoldable1` function for NonEmpty collections? + + -- Can't be deduplicated from CanEmpty collections due to use of Maybe , fromFoldable , head , init , last , tail , uncons + } - , fromList - , toList - - -- ? toUnfoldable1? - + -- CommonDiffEmptiability + -- Only testing a few of these functions here + { cons' + , snoc' } = do let l = makeCollection - cel = makeCanEmptyCollection + nil :: canEmpty Int + nil = cel [] + printTestType "Only nonEmpty" -- ======= Typeclass tests ======== @@ -846,22 +1402,25 @@ testOnlyNonEmpty -- ======= Functions tests ======== + -- These functions are only available for NonEmpty collections + log "fromList should convert from a List to a NonEmptyList" - assertEqual { actual: r.fromList $ cel [1, 2, 3], expected: Just $ l [1, 2, 3] } - assertEqual { actual: r.fromList $ cel ([] :: _ Int), expected: Nothing } + assertEqual { actual: fromList (cel [1, 2, 3]), expected: Just $ l [1, 2, 3] } + assertEqual { actual: fromList nil, expected: Nothing } log "toList should convert from a NonEmptyList to a List" - assertEqual { actual: r.toList $ l [1, 2, 3], expected: cel [1, 2, 3] } - + assertEqual { actual: toList (l [1, 2, 3]), expected: cel [1, 2, 3] } - -- Todo create tests for these functions - let - todo_toList = toList - todo_fromList = fromList - todo_fromFoldable = fromFoldable -- These are the remaining functions that can't be deduplicated due to use of Maybe + log "fromFoldable should create a collection from another foldable collection" + assertEqual { actual: fromFoldable [1, 2], expected: Just $ l [1, 2] } + assertEqual { actual: fromFoldable ([] :: _ Int), expected: Nothing } + assertEqual { actual: fromFoldable (Just 1), expected: Just $ l [1] } + assertEqual { actual: fromFoldable (Nothing :: _ Int), expected: Nothing } + + log "head should return a the first value" assertEqual { actual: head (l [1, 2]), expected: 1 } @@ -875,24 +1434,35 @@ testOnlyNonEmpty assertEqual { actual: tail (l [1, 2, 3]), expected: cel [2, 3] } log "uncons should split a collection into a record containing the first and remaining values" - assertEqual { actual: uncons (l [1]), expected: {head: 1, tail: cel []} } - assertEqual { actual: uncons (l [1, 2, 3]), expected: {head: 1, tail: cel [2, 3]} } + assertEqual { actual: uncons (l [1]), expected: { head: 1, tail: nil } } + assertEqual { actual: uncons (l [1, 2, 3]), expected: { head: 1, tail: cel [2, 3] } } + + + -- ========== Common API with additional canEmpty tests ========== + -- Note that cons' and snoc' must be tested here, rather than in + -- canEmpty, because we want a canEmpty arg and nonEmpty returned collection. + + log "cons' should work with empty collections" + assertEqual { actual: cons' 1 nil, expected: l [1] } + log "snoc' should work with empty collections" + assertEqual { actual: snoc' nil 3, expected: l [3] } testOnlyLazy :: forall c. - -- Lazy (c Int) => -- missing from LazyNonEmptyList - -- + Lazy (c Int) => -- Todo - missing from LazyNonEmptyList Eq (c Int) => Show (c Int) => - OnlyLazy c -> Effect Unit + OnlyLazy c -> + Common c -> + Effect Unit testOnlyLazy { makeCollection + , takeSimple -- Same names, but different APIs (without Maybe) - , alterAt , insertAt , modifyAt , updateAt @@ -907,36 +1477,152 @@ testOnlyLazy -- Specialized from Unfoldable1's replicate1 / replicate1A , replicate1 , replicate1M + } + + -- Reusing some Common functions for these Lazy tests. + -- Note, must use `com` named pattern to work around this bug: + -- https://github.com/purescript/purescript/issues/3938 + com@{ + cons + , length + , singleton } = do let l = makeCollection printTestType "Only Lazy" - -- Todo - create tests for these functions - let - todo_alterAt = alterAt - todo_iterate = iterate - todo_repeat = repeat - todo_cycle = cycle - todo_foldrLazy = foldrLazy - todo_scanlLazy = scanlLazy - todo_replicate1 = replicate1 - todo_replicate1M = replicate1M log "insertAt should add an item at the specified index" - assertEqual { actual: (insertAt 0 1 (l [2, 3])), expected: (l [1, 2, 3]) } - assertEqual { actual: (insertAt 1 1 (l [2, 3])), expected: (l [2, 1, 3]) } - assertEqual { actual: (insertAt 2 1 (l [2, 3])), expected: (l [2, 3, 1]) } + assertEqual { actual: insertAt 0 1 $ l [2, 3], expected: l [1, 2, 3] } + assertEqual { actual: insertAt 1 1 $ l [2, 3], expected: l [2, 1, 3] } + assertEqual { actual: insertAt 2 1 $ l [2, 3], expected: l [2, 3, 1] } + + log "insertAt should return the original collection if the index is out of range" + assertEqual { actual: insertAt 7 8 $ l [1,2,3], expected: l [1,2,3] } + assertEqual { actual: insertAt (-1) 8 $ l [1,2,3], expected: l [1,2,3] } + log "modifyAt should update an item at the specified index" - assertEqual { actual: (modifyAt 0 (_ + 1) (l [1, 2, 3])), expected: (l [2, 2, 3]) } - assertEqual { actual: (modifyAt 1 (_ + 1) (l [1, 2, 3])), expected: (l [1, 3, 3]) } + assertEqual { actual: modifyAt 0 (_ + 1) $ l [1, 2, 3], expected: l [2, 2, 3] } + assertEqual { actual: modifyAt 1 (_ + 1) $ l [1, 2, 3], expected: l [1, 3, 3] } + + log "modifyAt should return the original collection if the index is out of range" + assertEqual { actual: modifyAt 7 (_ + 1) $ l [1,2,3], expected: l [1,2,3] } + assertEqual { actual: modifyAt (-1) (_ + 1) $ l [1,2,3], expected: l [1,2,3] } + log "updateAt should replace an item at the specified index" - assertEqual { actual: (updateAt 0 9 (l [1, 2, 3])), expected: (l [9, 2, 3]) } - assertEqual { actual: (updateAt 1 9 (l [1, 2, 3])), expected: (l [1, 9, 3]) } + assertEqual { actual: updateAt 0 9 $ l [1, 2, 3], expected: l [9, 2, 3] } + assertEqual { actual: updateAt 1 9 $ l [1, 2, 3], expected: l [1, 9, 3] } + + log "updateAt should return the original collection if the index is out of range" + assertEqual { actual: updateAt 5 9 $ l [1, 2, 3], expected: l [1, 2, 3] } + assertEqual { actual: updateAt (-1) 9 $ l [1, 2, 3], expected: l [1, 2, 3] } + + let + t5 = takeSimple 5 + + log "repeate should create an infinite collection of a repeated element" + assertEqual { actual: t5 $ repeat 2, expected: l [2, 2, 2, 2, 2] } + + log "cycle should create an infinite collection by repeating another collection" + assertEqual { actual: t5 $ cycle (l [1, 2, 3]), expected: l [1, 2, 3, 1, 2] } + + log "iterate should create an infinite collection by iterating a function" + assertEqual { actual: t5 $ iterate (mul 2) 3, expected: l [3, 6, 12, 24, 48] } + + + log "foldrLazy should be correct" + assertEqual + { actual: foldrLazy (\a b -> (a * 2) `cons` b) (singleton (-1)) $ l [1, 2, 3] + , expected: l [2, 4, 6, -1] + } + + log "foldrLazy should work ok on infinite lists" + assertEqual + { actual: takeSimple 3 $ foldrLazy (\a b -> (a * 2) `cons` b) (singleton (-1)) $ iterate (add 1) 1 + , expected: l [2, 4, 6] + } + + + log "scanlLazy should be correct" + assertEqual + { actual: scanlLazy add 5 $ l [1, 2, 3, 4] + , expected: l [6, 8, 11, 15] + } + + log "scanlLazy should work ok on infinite lists" + assertEqual + { actual: takeSimple 4 $ scanlLazy add 5 $ iterate (add 1) 1 + , expected: l [6, 8, 11, 15] + } + + + log "replicate1 should be correct" + assertEqual { actual: replicate1 3 1, expected: l [1, 1, 1] } + assertEqual { actual: replicate1 1 1, expected: l [1] } + assertEqual { actual: replicate1 0 1, expected: l [1] } + assertEqual { actual: replicate1 (-1) 1, expected: l [1] } + + log "replicate1 should be stack-safe" + assertEqual { actual: length (replicate1 100000 1), expected: 100000 } + + log "replicate1 should be lazy" + assertEqual { actual: takeSimple 3 $ replicate1 100000000 1, expected: l [1, 1, 1] } + + + log "replicate1M should be correct" + assertEqual { actual: replicate1M 3 $ Just 1, expected: Just $ l [1, 1, 1] } + assertEqual { actual: replicate1M 1 $ Just 1, expected: Just $ l [1] } + assertEqual { actual: replicate1M 0 $ Just 1, expected: Just $ l [1] } + assertEqual { actual: replicate1M (-1) $ Just 1, expected: Just $ l [1] } + + assertEqual { actual: replicate1M 3 (Nothing :: _ Int), expected: Nothing } + assertEqual { actual: replicate1M 1 (Nothing :: _ Int), expected: Nothing } + assertEqual { actual: replicate1M 0 (Nothing :: _ Int), expected: Nothing } + assertEqual { actual: replicate1M (-1) (Nothing :: _ Int), expected: Nothing } + + log "replicate1M should be stack-safe" + -- Must use com. here because of this typechecker bug: + -- https://github.com/purescript/purescript/issues/3938#issuecomment-880390437 + assertEqual { actual: map com.length (replicate1M 100000 (Just 1)), expected: Just 100000 } + assertEqual { actual: map com.length (replicate1M 100000 (Nothing :: _ Int)), expected: Nothing } + log "replicate1M should be lazy" + assertEqual { actual: map (takeSimple 3) $ replicate1M 100000000 $ Just 1, expected: Just $ l [1, 1, 1] } + assertEqual { actual: map (takeSimple 3) $ replicate1M 100000000 $ (Nothing :: _ Int), expected: Nothing } + + + -- Additional common tests for lazy collections + + -- todo, reorder + + log "nub should not consume more of the input list than necessary" + assertEqual + { actual: takeSimple 3 $ com.nub (cycle (l [1, 2, 3])) + , expected: l [1, 2, 3] + } + + + -- Todo - nubEq, etc + + + let + nonZeroAdd 0 _ = Nothing + nonZeroAdd _ 0 = Nothing + nonZeroAdd x y = Just $ x + y + + log "zipWithA should work with infinite lists" + assertEqual { actual: com.zipWithA nonZeroAdd (repeat 1) $ l [1, 2, 3], expected: Just $ l [11, 12, 13] } + assertEqual { actual: com.zipWithA nonZeroAdd (l [1, 2, 3]) $ repeat 1, expected: Just $ l [11, 12, 13] } + assertEqual { actual: com.zipWithA nonZeroAdd (repeat 1) $ cycle (l [1, 2, 0]), expected: Nothing } + + log "foldM should work ok on infinite lists" + assertEqual { actual: com.foldM nonZeroAdd 1 $ cycle (l [1, 2, 0]), expected: Nothing } + + log "range should be lazy" + assertEqual { actual: takeSimple 3 $ com.range 0 100000000, expected: l [0, 1, 2] } testOnlyStrict :: forall c. Eq (c Int) => @@ -946,7 +1632,6 @@ testOnlyStrict { makeCollection -- Same names, but different APIs (with Maybe) - , alterAt , insertAt , modifyAt , updateAt @@ -958,53 +1643,45 @@ testOnlyStrict printTestType "Only Strict" - -- Todo - create tests for these functions - let - todo_alterAt = alterAt - todo_insertAt = insertAt - todo_modifyAt = modifyAt - todo_updateAt = updateAt - - -- log "insertAt should add an item at the specified index" - -- assertEqual { actual: insertAt 0 1 $ l [2, 3], expected: Just $ l [1, 2, 3] } - -- assertEqual { actual: insertAt 1 1 $ l [2, 3], expected: Just $ l [2, 1, 3] } - -- assertEqual { actual: insertAt 2 1 $ l [2, 3], expected: Just $ l [2, 3, 1] } - - -- log "insertAt should return Nothing if the index is out of range" - -- assertEqual { actual: insertAt 7 8 $ l [1,2,3], expected: Nothing } - - -- todo insertAt test - -- missing from original test suite + log "insertAt should add an item at the specified index" + assertEqual { actual: insertAt 0 1 $ l [2, 3], expected: Just $ l [1, 2, 3] } + assertEqual { actual: insertAt 1 1 $ l [2, 3], expected: Just $ l [2, 1, 3] } + assertEqual { actual: insertAt 2 1 $ l [2, 3], expected: Just $ l [2, 3, 1] } - -- log "modifyAt should update an item at the specified index" - -- assertEqual { actual: modifyAt 0 (_ + 1) $ l [1, 2, 3], expected: Just $ l [2, 2, 3] } - -- assertEqual { actual: modifyAt 1 (_ + 1) $ l [1, 2, 3], expected: Just $ l [1, 3, 3] } + log "insertAt should return Nothing if the index is out of range" + assertEqual { actual: insertAt 7 8 $ l [1,2,3], expected: Nothing } + assertEqual { actual: insertAt (-1) 8 $ l [1,2,3], expected: Nothing } - -- log "modifyAt should return Nothing if the index is out of range" - -- assertEqual { actual: modifyAt 7 (_ + 1) $ l [1,2,3], expected: Nothing } + log "modifyAt should update an item at the specified index" + assertEqual { actual: modifyAt 0 (_ + 1) $ l [1, 2, 3], expected: Just $ l [2, 2, 3] } + assertEqual { actual: modifyAt 1 (_ + 1) $ l [1, 2, 3], expected: Just $ l [1, 3, 3] } - -- todo modifyAt test - -- missing from original test suite + log "modifyAt should return Nothing if the index is out of range" + assertEqual { actual: modifyAt 7 (_ + 1) $ l [1,2,3], expected: Nothing } + assertEqual { actual: modifyAt (-1) (_ + 1) $ l [1,2,3], expected: Nothing } log "updateAt should replace an item at the specified index" - assertEqual { actual: (updateAt 0 9 (l [1, 2, 3])), expected: Just (l [9, 2, 3]) } - assertEqual { actual: (updateAt 1 9 (l [1, 2, 3])), expected: Just (l [1, 9, 3]) } + assertEqual { actual: updateAt 0 9 $ l [1, 2, 3], expected: Just $ l [9, 2, 3] } + assertEqual { actual: updateAt 1 9 $ l [1, 2, 3], expected: Just $ l [1, 9, 3] } log "updateAt should return Nothing if the index is out of range" - assertEqual { actual: (updateAt 5 9 (l [1, 2, 3])), expected: Nothing } + assertEqual { actual: updateAt 5 9 $ l [1, 2, 3], expected: Nothing } + assertEqual { actual: updateAt (-1) 9 $ l [1, 2, 3], expected: Nothing } -- Functions that cannot be tested generically. - -assertSkipAlways :: (_ -> Boolean) -> Effect Unit -assertSkipAlways _ = - log "...skipped" - +-- helper func +removeZerosAndDouble :: Int -> Maybe Int +removeZerosAndDouble 0 = Nothing +removeZerosAndDouble n = Just $ 2 * n testOnlyStrictCanEmpty :: OnlyStrictCanEmpty L.List -> Effect Unit -testOnlyStrictCanEmpty { deleteAt } = do +testOnlyStrictCanEmpty + { alterAt + , deleteAt + } = do let l :: forall f a. Foldable f => f a -> L.List a @@ -1014,17 +1691,29 @@ testOnlyStrictCanEmpty { deleteAt } = do -- Common function names, but different signatures - log "deleteAt should remove an item at the specified index" - assertEqual { actual: deleteAt 0 (l [1, 2, 3]), expected: Just (l [2, 3]) } - assertEqual { actual: deleteAt 1 (l [1, 2, 3]), expected: Just (l [1, 3]) } + log "alterAt should remove an item at the specified index" + assertEqual { actual: alterAt 0 removeZerosAndDouble $ l [1, 2, 3], expected: Just $ l [2, 2, 3] } + assertEqual { actual: alterAt 1 removeZerosAndDouble $ l [1, 0, 3], expected: Just $ l [1, 3] } - -- Corner Cases + log "alterAt should return Nothing if index is out of bounds" + assertEqual { actual: alterAt 5 removeZerosAndDouble $ l [1, 2, 3], expected: Nothing } + assertEqual { actual: alterAt (-1) removeZerosAndDouble $ l [1, 2, 3], expected: Nothing } - -- Unique functions + + log "deleteAt should remove an item at the specified index" + assertEqual { actual: deleteAt 0 $ l [1, 2, 3], expected: Just $ l [2, 3] } + assertEqual { actual: deleteAt 1 $ l [1, 2, 3], expected: Just $ l [1, 3] } + + log "deleteAt should return Nothing if index is out of bounds" + assertEqual { actual: deleteAt 5 $ l [1, 2, 3], expected: Nothing } + assertEqual { actual: deleteAt (-1) $ l [1, 2, 3], expected: Nothing } testOnlyStrictNonEmpty :: OnlyStrictNonEmpty NEL.NonEmptyList L.List -> Effect Unit -testOnlyStrictNonEmpty { deleteAt } = do +testOnlyStrictNonEmpty + { alterAt + , deleteAt + } = do let l :: forall f a. Foldable f => f a -> NEL.NonEmptyList a @@ -1037,18 +1726,30 @@ testOnlyStrictNonEmpty { deleteAt } = do -- Common function names, but different signatures - log "deleteAt should remove an item at the specified index" - assertSkipAlways \_ -> deleteAt 0 (l [1, 2, 3]) == Just (cel [2, 3]) - assertSkipAlways \_ -> deleteAt 1 (l [1, 2, 3]) == Just (cel [1, 3]) + log "alterAt should remove an item at the specified index" + assertEqual { actual: alterAt 0 removeZerosAndDouble $ l [1, 2, 3], expected: Just $ cel [2, 2, 3] } + assertEqual { actual: alterAt 1 removeZerosAndDouble $ l [1, 0, 3], expected: Just $ cel [1, 3] } - -- Corner Cases + log "alterAt should return Nothing if index is out of bounds" + assertEqual { actual: alterAt 5 removeZerosAndDouble $ l [1, 2, 3], expected: Nothing } + assertEqual { actual: alterAt (-1) removeZerosAndDouble $ l [1, 2, 3], expected: Nothing } - -- Unique functions + + log "deleteAt should remove an item at the specified index" + assertSkipAlways \_ -> { actual: deleteAt 0 $ l [1, 2, 3], expected: Just $ cel [2, 3] } + assertSkipAlways \_ -> { actual: deleteAt 1 $ l [1, 2, 3], expected: Just $ cel [1, 3] } + + log "deleteAt should return Nothing if index is out of bounds" + assertSkipAlways \_ -> { actual: deleteAt 5 $ l [1, 2, 3], expected: Nothing } + assertSkipAlways \_ -> { actual: deleteAt (-1) $ l [1, 2, 3], expected: Nothing } testOnlyLazyCanEmpty :: OnlyLazyCanEmpty LL.List -> Effect Unit testOnlyLazyCanEmpty - { deleteAt + -- Common function names, but different signatures + { alterAt + , deleteAt + -- Unique functions , replicate , replicateM } = do @@ -1057,27 +1758,87 @@ testOnlyLazyCanEmpty l :: forall f a. Foldable f => f a -> LL.List a l = LL.fromFoldable + nil = l [] + printTestType "Only Lazy canEmpty" -- Common function names, but different signatures + log "alterAt should remove an item at the specified index" + assertEqual { actual: alterAt 0 removeZerosAndDouble $ l [1, 2, 3], expected: l [2, 2, 3] } + assertEqual { actual: alterAt 1 removeZerosAndDouble $ l [1, 0, 3], expected: l [1, 3] } + + log "alterAt should return the original collection if index is out of bounds" + assertEqual { actual: alterAt 5 removeZerosAndDouble $ l [1, 2, 3], expected: l [1, 2, 3] } + assertEqual { actual: alterAt (-1) removeZerosAndDouble $ l [1, 2, 3], expected: l [1, 2, 3] } + + log "deleteAt should remove an item at the specified index" - assertEqual { actual: deleteAt 0 (l [1, 2, 3]), expected: l [2, 3] } - assertEqual { actual: deleteAt 1 (l [1, 2, 3]), expected: l [1, 3] } + assertEqual { actual: deleteAt 0 $ l [1, 2, 3], expected: l [2, 3] } + assertEqual { actual: deleteAt 1 $ l [1, 2, 3], expected: l [1, 3] } - -- Corner Cases + log "deleteAt should return the original collection if index is out of bounds" + assertEqual { actual: deleteAt 5 $ l [1, 2, 3], expected: l [1, 2, 3] } + assertEqual { actual: deleteAt (-1) $ l [1, 2, 3], expected: l [1, 2, 3] } -- Unique functions - -- Todo create tests for these functions - let - todo_replicate = replicate - todo_replicateM = replicateM - pure unit + log "replicate should be correct" + assertEqual { actual: replicate 3 1, expected: l [1, 1, 1] } + assertEqual { actual: replicate 1 1, expected: l [1] } + assertEqual { actual: replicate 0 1, expected: nil } + assertEqual { actual: replicate (-1) 1, expected: nil } + + log "replicate should be stack-safe" + assertEqual { actual: LL.length (replicate 100000 1), expected: 100000 } + + log "replicate should be lazy" + assertEqual { actual: LL.take 3 $ replicate 100000000 1, expected: l [1, 1, 1] } + + + log "replicate should be correct" + assertEqual { actual: replicateM 3 $ Just 1, expected: Just $ l [1, 1, 1] } + assertEqual { actual: replicateM 1 $ Just 1, expected: Just $ l [1] } + assertEqual { actual: replicateM 0 $ Just 1, expected: Just nil } + assertEqual { actual: replicateM (-1) $ Just 1, expected: Just nil } + + assertEqual { actual: replicateM 3 (Nothing :: _ Int), expected: Nothing } + assertEqual { actual: replicateM 1 (Nothing :: _ Int), expected: Nothing } + assertEqual { actual: replicateM 0 (Nothing :: _ Int), expected: Nothing } + assertEqual { actual: replicateM (-1) (Nothing :: _ Int), expected: Nothing } + + log "replicateM should be stack-safe" + assertEqual { actual: map LL.length (replicateM 100000 (Just 1)), expected: Just 100000 } + assertEqual { actual: map LL.length (replicateM 100000 (Nothing :: _ Int)), expected: Nothing } + + log "replicateM should be lazy" + assertEqual { actual: map (LL.take 3) $ replicateM 100000000 $ Just 1, expected: Just $ l [1, 1, 1] } + assertEqual { actual: map (LL.take 3) $ replicateM 100000000 $ (Nothing :: _ Int), expected: Nothing } + +{- + -- This currently only works for lazy-can-empty. + -- It also requires access to some additional common functions. + -- Might not be worth keeping. + + log "can find the first 10 primes using lazy collections" + let eratos :: c Int -> c Int + eratos xs = defer \_ -> + case com.uncons xs of + Nothing -> nil + Just { head: p, tail: ys } -> p `cons` eratos (filter (\x -> x `mod` p /= 0) ys) + + primes = eratos $ iterate (add 1) 2 + + assertEqual { actual: takeSimple 10 primes, expected: l [2, 3, 5, 7, 11, 13, 17, 19, 23, 29] } +-} + testOnlyLazyNonEmpty :: OnlyLazyNonEmpty LNEL.NonEmptyList LL.List -> Effect Unit -testOnlyLazyNonEmpty { deleteAt } = do +testOnlyLazyNonEmpty + { alterAt + , deleteAt + } = do let l :: forall f a. Foldable f => f a -> LNEL.NonEmptyList a @@ -1090,10 +1851,19 @@ testOnlyLazyNonEmpty { deleteAt } = do -- Common function names, but different signatures - log "deleteAt should remove an item at the specified index" - assertEqual { actual: deleteAt 0 (l [1, 2, 3]), expected: cel [2, 3] } - assertEqual { actual: deleteAt 1 (l [1, 2, 3]), expected: cel [1, 3] } + log "alterAt should remove an item at the specified index" + assertEqual { actual: alterAt 0 removeZerosAndDouble $ l [1, 2, 3], expected: cel [2, 2, 3] } + assertEqual { actual: alterAt 1 removeZerosAndDouble $ l [1, 0, 3], expected: cel [1, 3] } - -- Corner Cases + log "alterAt should return the original collection if index is out of bounds" + assertEqual { actual: alterAt 5 removeZerosAndDouble $ l [1, 2, 3], expected: cel [1, 2, 3] } + assertEqual { actual: alterAt (-1) removeZerosAndDouble $ l [1, 2, 3], expected: cel [1, 2, 3] } - -- Unique functions + + log "deleteAt should remove an item at the specified index" + assertEqual { actual: deleteAt 0 $ l [1, 2, 3], expected: cel [2, 3] } + assertEqual { actual: deleteAt 1 $ l [1, 2, 3], expected: cel [1, 3] } + + log "deleteAt should return the original collection if index is out of bounds" + assertEqual { actual: deleteAt 5 $ l [1, 2, 3], expected: cel [1, 2, 3] } + assertEqual { actual: deleteAt (-1) $ l [1, 2, 3], expected: cel [1, 2, 3] } diff --git a/test/Test/Args/LazyList.purs b/test/Test/Args/LazyList.purs index b447eef..2f8ffc6 100644 --- a/test/Test/Args/LazyList.purs +++ b/test/Test/Args/LazyList.purs @@ -66,6 +66,7 @@ commonDiffEmptiability = { makeCollection , makeCanEmptyCollection , makeNonEmptyCollection + , makeInverseCollection: makeNonEmptyCollection , catMaybes , drop @@ -94,10 +95,9 @@ commonDiffEmptiability = , stripPrefix } -onlyCanEmpty :: OnlyCanEmpty List NEL.NonEmptyList +onlyCanEmpty :: OnlyCanEmpty List onlyCanEmpty = { makeCollection - , makeNonEmptyCollection , fromFoldable , head @@ -114,8 +114,8 @@ onlyCanEmpty = onlyLazy :: OnlyLazy List onlyLazy = { makeCollection + , takeSimple: take - , alterAt , insertAt , modifyAt , updateAt @@ -132,7 +132,8 @@ onlyLazy = onlyLazyCanEmpty :: OnlyLazyCanEmpty List onlyLazyCanEmpty = - { deleteAt + { alterAt + , deleteAt , replicate , replicateM } \ No newline at end of file diff --git a/test/Test/Args/LazyNonEmptyList.purs b/test/Test/Args/LazyNonEmptyList.purs index 59c5e4f..87c2775 100644 --- a/test/Test/Args/LazyNonEmptyList.purs +++ b/test/Test/Args/LazyNonEmptyList.purs @@ -18,6 +18,10 @@ makeCanEmptyCollection = L.fromFoldable makeNonEmptyCollection :: forall a f. Foldable f => f a -> NonEmptyList a makeNonEmptyCollection = makeCollection +-- Suppress conversion to canEmpty list to enable common testing code +takeSimple :: forall a. Int -> NonEmptyList a -> NonEmptyList a +takeSimple n = unsafePartial fromJust <<< fromList <<< take n + common :: Common NonEmptyList common = { makeCollection @@ -65,6 +69,7 @@ commonDiffEmptiability = { makeCollection , makeCanEmptyCollection , makeNonEmptyCollection + , makeInverseCollection: makeCanEmptyCollection , catMaybes , drop @@ -112,8 +117,8 @@ onlyNonEmpty = onlyLazy :: OnlyLazy NonEmptyList onlyLazy = { makeCollection + , takeSimple - , alterAt , insertAt , modifyAt , updateAt @@ -130,4 +135,6 @@ onlyLazy = onlyLazyNonEmpty :: OnlyLazyNonEmpty NonEmptyList L.List onlyLazyNonEmpty = - { deleteAt } \ No newline at end of file + { alterAt + , deleteAt + } \ No newline at end of file diff --git a/test/Test/Args/List.purs b/test/Test/Args/List.purs index 8958310..d93f373 100644 --- a/test/Test/Args/List.purs +++ b/test/Test/Args/List.purs @@ -65,6 +65,7 @@ commonDiffEmptiability = { makeCollection , makeCanEmptyCollection , makeNonEmptyCollection + , makeInverseCollection: makeNonEmptyCollection , catMaybes , drop @@ -93,10 +94,9 @@ commonDiffEmptiability = , stripPrefix } -onlyCanEmpty :: OnlyCanEmpty List NEL.NonEmptyList +onlyCanEmpty :: OnlyCanEmpty List onlyCanEmpty = { makeCollection - , makeNonEmptyCollection , fromFoldable , head @@ -114,7 +114,6 @@ onlyStrict :: OnlyStrict List onlyStrict = { makeCollection - , alterAt , insertAt , modifyAt , updateAt @@ -122,4 +121,6 @@ onlyStrict = onlyStrictCanEmpty :: OnlyStrictCanEmpty List onlyStrictCanEmpty = - { deleteAt } \ No newline at end of file + { alterAt + , deleteAt + } \ No newline at end of file diff --git a/test/Test/Args/NonEmptyList.purs b/test/Test/Args/NonEmptyList.purs index 0c426e5..cffd296 100644 --- a/test/Test/Args/NonEmptyList.purs +++ b/test/Test/Args/NonEmptyList.purs @@ -65,6 +65,7 @@ commonDiffEmptiability = { makeCollection , makeCanEmptyCollection , makeNonEmptyCollection + , makeInverseCollection: makeCanEmptyCollection , catMaybes , drop @@ -113,7 +114,6 @@ onlyStrict :: OnlyStrict NonEmptyList onlyStrict = { makeCollection - , alterAt , insertAt , modifyAt , updateAt @@ -121,4 +121,6 @@ onlyStrict = onlyStrictNonEmpty :: OnlyStrictNonEmpty NonEmptyList L.List onlyStrictNonEmpty = - { deleteAt } \ No newline at end of file + { alterAt + , deleteAt + } \ No newline at end of file diff --git a/test/Test/UpdatedTests.purs b/test/Test/UpdatedTests.purs index abef5ba..da53348 100644 --- a/test/Test/UpdatedTests.purs +++ b/test/Test/UpdatedTests.purs @@ -51,7 +51,7 @@ testBasicList = do T.testCommon LA.common T.testCommonDiffEmptiability T.RunAll LA.commonDiffEmptiability - T.testOnlyCanEmpty LA.onlyCanEmpty + T.testOnlyCanEmpty T.SkipBrokenStrictCanEmpty LA.onlyCanEmpty LA.common LA.commonDiffEmptiability T.testOnlyStrict LA.onlyStrict T.testOnlyStrictCanEmpty LA.onlyStrictCanEmpty @@ -62,7 +62,7 @@ testNonEmptyList = do T.testCommon NELA.common T.testCommonDiffEmptiability T.SkipBrokenStrictNonEmpty NELA.commonDiffEmptiability - T.testOnlyNonEmpty NELA.onlyNonEmpty + T.testOnlyNonEmpty NELA.onlyNonEmpty NELA.commonDiffEmptiability T.testOnlyStrict NELA.onlyStrict T.testOnlyStrictNonEmpty NELA.onlyStrictNonEmpty @@ -71,8 +71,8 @@ testLazyList = do T.testCommon LLA.common T.testCommonDiffEmptiability T.SkipBrokenLazyCanEmpty LLA.commonDiffEmptiability - T.testOnlyCanEmpty LLA.onlyCanEmpty - T.testOnlyLazy LLA.onlyLazy + T.testOnlyCanEmpty T.SkipBrokenLazyCanEmpty LLA.onlyCanEmpty LLA.common LLA.commonDiffEmptiability + T.testOnlyLazy LLA.onlyLazy LLA.common T.testOnlyLazyCanEmpty LLA.onlyLazyCanEmpty @@ -85,21 +85,6 @@ testLazyNonEmptyList = do -- worth using the assertSkip strategy T.testCommon LNELA.common T.testCommonDiffEmptiability T.RunAll LNELA.commonDiffEmptiability - T.testOnlyNonEmpty LNELA.onlyNonEmpty - T.testOnlyLazy LNELA.onlyLazy - T.testOnlyLazyNonEmpty LNELA.onlyLazyNonEmpty - --- nil is passed instead of a singleton, --- because some of the functions use this --- as a convenience value -nil :: L.List Int -nil = L.Nil - -lazyNil :: LL.List Int -lazyNil = LL.nil - -nonEmpty :: NEL.NonEmptyList Int -nonEmpty = NEL.singleton 1 - -lazyNonEmpty :: LNEL.NonEmptyList Int -lazyNonEmpty = LNEL.singleton 1 \ No newline at end of file + T.testOnlyNonEmpty LNELA.onlyNonEmpty LNELA.commonDiffEmptiability + T.testOnlyLazy LNELA.onlyLazy LNELA.common + T.testOnlyLazyNonEmpty LNELA.onlyLazyNonEmpty \ No newline at end of file