Add Unfoldable1

src/Data/Unfoldable1.purs

@@ -0,0 +1,73 @@
+module Data.Unfoldable1
+  ( class Unfoldable1, unfoldr1
+  , replicate1
+  , replicate1A
+  , singleton
+  , range
+  ) where
+
+import Prelude
+
+import Data.Maybe (Maybe(..))
+import Data.Traversable (class Traversable, sequence)
+import Data.Tuple (Tuple(..))
+
+-- | This class identifies non-empty data structures which can be _unfolded_,
+-- | generalizing `unfoldr1` on non-empty lists or arrays.
+-- |
+-- | The generating function `f` corresponds to the `uncons` operation of a
+-- | non-empty list or array; it always return a value, and then optionally
+-- | a value to continue unfolding from.
+class Unfoldable1 t where
+  unfoldr1 :: forall a b. (b -> Tuple a (Maybe b)) -> b -> t a
+
+-- | Replicate a value `n` times. At least one value will be produced, so values
+-- | `n < 1` less than one will be ignored.
+-- |
+-- | ``` purescript
+-- | replicate1 0 "foo" == NEL.singleton "foo" :: NEL.NonEmptyList String
+-- | replicate1 2 "foo" == NEL.cons "foo" (NEL.singleton "foo") :: NEL.NonEmptyList String
+-- | ```
+replicate1 :: forall f a. Unfoldable1 f => Int -> a -> f a
+replicate1 n v = unfoldr1 step (n - 1)
+  where
+    step :: Int -> Tuple a (Maybe Int)
+    step i
+      | i <= 0 = Tuple v Nothing
+      | otherwise = Tuple v (Just (i - 1))
+
+-- | Perform an `Applicative` action `n` times (at least once, so values `n < 1`
+-- | less than one will be ignored), and accumulate the results.
+replicate1A
+  :: forall m f a
+   . Applicative m
+  => Unfoldable1 f
+  => Traversable f
+  => Int
+  -> m a
+  -> m (f a)
+replicate1A n m = sequence (replicate1 n m)
+
+-- | Contain a single value. For example:
+-- |
+-- | ``` purescript
+-- | singleton "foo" == NEL.singleton "foo" :: NEL.NonEmptyList String
+-- | ```
+singleton :: forall f a. Unfoldable1 f => a -> f a
+singleton = replicate1 1
+
+-- | Create an `Unfoldable1` containing a range of values, including both
+-- | endpoints.
+-- |
+-- | ``` purescript
+-- | range 0 0 "foo" == NEL.singleton 0 :: NEL.NonEmptyList Int
+-- | range 1 2 "foo" == NEL.cons 1 (NEL.singleton 2) :: NEL.NonEmptyList Int
+-- | range 2 0 "foo" == NEL.cons 2 (NEL.cons 1 (NEL.singleton 0)) :: NEL.NonEmptyList Int
+-- | ```
+range :: forall f. Unfoldable1 f => Int -> Int -> f Int
+range start end =
+  let delta = if end >= start then 1 else -1 in unfoldr1 (go delta) start
+  where
+    go delta i =
+      let i' = i + delta
+      in Tuple i (if i == end then Nothing else Just i')

test/Main.purs

@@ -4,13 +4,19 @@ import Prelude
 
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, log, logShow)
-
 import Data.Maybe (Maybe(..))
-import Data.Tuple (Tuple(..))
+import Data.Tuple (Tuple(..), uncurry)
 import Data.Unfoldable as U
-
+import Data.Unfoldable1 as U1
 import Test.Assert (ASSERT, assert)
 
+data NonEmpty f a = NonEmpty a (f a)
+
+derive instance eqNonEmpty :: (Eq (f a), Eq a) => Eq (NonEmpty f a)
+
+instance unfoldable1NonEmpty :: U.Unfoldable f => U1.Unfoldable1 (NonEmpty f) where
+  unfoldr1 f = uncurry NonEmpty <<< map (U.unfoldr $ map f) <<< f
+
 collatz :: Int -> Array Int
 collatz = U.unfoldr step
   where
@@ -32,21 +38,30 @@ main = do
 
   log "Test singleton"
   assert $ U.singleton unit == [unit]
+  assert $ U1.singleton unit == NonEmpty unit []
 
   log "Test replicate"
+  assert $ U.replicate 0 "foo" == []
   assert $ U.replicate 3 "foo" == ["foo", "foo", "foo"]
+  assert $ U1.replicate1 0 "foo" == NonEmpty "foo" []
+  assert $ U1.replicate1 3 "foo" == NonEmpty "foo" ["foo", "foo"]
 
   log "Test replicateA"
   assert $ U.replicateA 3 [1,2] == [
     [1,1,1],[1,1,2], [1,2,1],[1,2,2],
     [2,1,1],[2,1,2], [2,2,1],[2,2,2]
   ]
 
-  log "Test range"
+  log "Test U.range"
   assert $ U.range 1 0 == []
   assert $ U.range 0 0 == [0]
   assert $ U.range 0 2 == [0, 1, 2]
 
+  log "Test U1.range"
+  assert $ U1.range 1 0 == NonEmpty 1 [0]
+  assert $ U1.range 0 0 == NonEmpty 0 []
+  assert $ U1.range 0 2 == NonEmpty 0 [1, 2]
+
   log "Test Maybe.toUnfoldable"
   assert $ U.fromMaybe (Just "a") == ["a"]
   assert $ U.fromMaybe (Nothing :: Maybe String) == []