Law-abiding Apply NonEmptyList that agrees with Apply List

CHANGELOG.md

@@ -6,10 +6,14 @@ Notable changes to this project are documented in this file. The format is based
 
 Breaking changes:
 
+- Change `Apply NonEmptyList` instance to obey `Apply` and `Applicative` laws, and agree with `Apply List` (#222 by @UnrelatedString)
+
 New features:
 
 Bugfixes:
 
+- Change `Apply NonEmptyList` instance to obey `Apply` and `Applicative` laws, and agree with `Apply List` (#222 by @UnrelatedString)
+
 Other improvements:
 
 ## [v7.0.0](https://github.com/purescript/purescript-lists/releases/tag/v7.0.0) - 2022-04-27

src/Data/List/Lazy/Types.purs

@@ -230,7 +230,7 @@ instance applyNonEmptyList :: Apply NonEmptyList where
   apply (NonEmptyList nefs) (NonEmptyList neas) =
     case force nefs, force neas of
       f :| fs, a :| as ->
-        NonEmptyList (defer \_ -> f a :| (fs <*> a : nil) <> ((f : fs) <*> as))
+        NonEmptyList (defer \_ -> f a :| map f as <> apply fs (a : as))
 
 instance applicativeNonEmptyList :: Applicative NonEmptyList where
   pure a = NonEmptyList (defer \_ -> NE.singleton a)

src/Data/List/Types.purs

@@ -209,7 +209,7 @@ derive newtype instance functorNonEmptyList :: Functor NonEmptyList
 
 instance applyNonEmptyList :: Apply NonEmptyList where
   apply (NonEmptyList (f :| fs)) (NonEmptyList (a :| as)) =
-    NonEmptyList (f a :| (fs <*> a : Nil) <> ((f : fs) <*> as))
+    NonEmptyList (f a :| map f as <> apply fs (a : as))
 
 instance applicativeNonEmptyList :: Applicative NonEmptyList where
   pure = NonEmptyList <<< NE.singleton

test/Test/Data/List/Lazy.purs

@@ -12,7 +12,7 @@ import Data.List.Lazy (List, Pattern(..), alterAt, catMaybes, concat, concatMap,
 import Data.List.Lazy.NonEmpty as NEL
 import Data.Maybe (Maybe(..), isNothing, fromJust)
 import Data.Monoid.Additive (Additive(..))
-import Data.NonEmpty ((:|))
+import Data.NonEmpty (NonEmpty, (:|))
 import Data.Traversable (traverse)
 import Data.TraversableWithIndex (traverseWithIndex)
 import Data.Tuple (Tuple(..))
@@ -27,6 +27,7 @@ testListLazy :: Effect Unit
 testListLazy = do
   let
     l = fromFoldable
+    nel :: NonEmpty List ~> NEL.NonEmptyList
     nel xxs = NEL.NonEmptyList (Z.defer \_ -> xxs)
     longList = range 1 100000
   log "strip prefix"
@@ -459,6 +460,12 @@ testListLazy = do
   log "unfoldr1 should maintain order for NEL"
   assert $ (nel (1 :| l [2, 3, 4, 5])) == unfoldr1 step1 1
 
+  log "lazy Apply NEL should agree with Apply List"
+  assert $
+      l (Tuple <$> nel (1 :| l [2, 3, 4]) <*> nel ('a' :| l ['b', 'c', 'd']))
+    ==
+      (Tuple <$> l [1, 2, 3, 4] <*> l ['a', 'b', 'c', 'd'])
+
 step :: Int -> Maybe (Tuple Int Int)
 step 6 = Nothing
 step n = Just (Tuple n (n + 1))

test/Test/Data/List/NonEmpty.purs

@@ -281,6 +281,9 @@ testNonEmptyList = do
   log "unfoldr1 should maintain order"
   assert $ (nel 1 [2, 3, 4, 5]) == unfoldr1 step1 1
 
+  log "apply should agree with Apply List"
+  assert $ l (Tuple <$> nel 1 [2, 3, 4] <*> nel 'a' ['b', 'c', 'd']) == (Tuple <$> l [1, 2, 3, 4] <*> l ['a', 'b', 'c', 'd'])
+
 step1 :: Int -> Tuple Int (Maybe Int)
 step1 n = Tuple n (if n >= 5 then Nothing else Just (n + 1))