From 49acc40ce77b21f8c325d6ffd17ed17dae2f8678 Mon Sep 17 00:00:00 2001 From: Miles Frain Date: Sat, 19 Dec 2020 12:16:25 -0800 Subject: [PATCH 1/8] 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 2/8] 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 3/8] 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 4/8] 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 5/8] 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 6/8] 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 7/8] 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 8/8] 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