add stripPrefix and Pattern for Data.List

package.json

@@ -6,8 +6,8 @@
     "test": "pulp test"
   },
   "devDependencies": {
-    "pulp": "^10.0.4",
-    "purescript-psa": "^0.5.0-rc.1",
+    "pulp": "^11.0.0",
+    "purescript-psa": "^0.5.1",
     "rimraf": "^2.6.1"
   }
 }

src/Data/List.purs

@@ -56,6 +56,8 @@ module Data.List
   , sort
   , sortBy
 
+  , Pattern(..)
+  , stripPrefix
   , slice
   , take
   , takeWhile
@@ -94,13 +96,14 @@ import Prelude
 import Control.Alt ((<|>))
 import Control.Alternative (class Alternative)
 import Control.Lazy (class Lazy, defer)
-import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
+import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM, tailRecM2)
 
 import Data.Bifunctor (bimap)
 import Data.Foldable (class Foldable, foldr, any, foldl)
 import Data.List.Types (List(..), (:))
 import Data.List.Types (NonEmptyList(..)) as NEL
 import Data.Maybe (Maybe(..))
+import Data.Newtype (class Newtype)
 import Data.NonEmpty ((:|))
 import Data.Traversable (sequence)
 import Data.Tuple (Tuple(..))
@@ -476,6 +479,32 @@ sortBy cmp = mergeAll <<< sequences
 -- Sublists --------------------------------------------------------------------
 --------------------------------------------------------------------------------
 
+-- | A newtype used in cases where there is a list to be matched.
+newtype Pattern a = Pattern (List 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 <> ")"
+
+
+-- | If the list starts with the given prefix, return the portion of the
+-- | list left after removing it, as a Just value. Otherwise, return Nothing.
+-- | * `stripPrefix (Pattern (1:Nil)) (1:2:Nil) == Just (2:Nil)`
+-- | * `stripPrefix (Pattern Nil) (1:Nil) == Just (1:Nil)`
+-- | * `stripPrefix (Pattern (2:Nil)) (1:Nil) == Nothing`
+-- |
+-- | Running time: `O(n)` where `n` is the number of elements to strip.
+stripPrefix :: forall a. Eq a => Pattern a -> List a -> Maybe (List a)
+stripPrefix (Pattern p') s = tailRecM2 go p' s
+  where
+  go prefix input = case prefix, input of
+    Cons p ps, Cons i is | p == i -> Just $ Loop { a: ps, b: is }
+    Nil, is -> Just $ Done is
+    _, _ -> Nothing
+
 -- | Extract a sublist by a start and end index.
 slice :: Int -> Int -> List ~> List
 slice start end xs = take (end - start) (drop start xs)

test/Test/Data/List.purs

@@ -5,7 +5,7 @@ import Data.List.NonEmpty as NEL
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, log)
 import Data.Foldable (foldMap, foldl)
-import Data.List (List(..), (..), length, range, foldM, unzip, zip, zipWithA, zipWith, intersectBy, intersect, (\\), deleteBy, delete, unionBy, union, nubBy, nub, groupBy, group', group, partition, span, dropWhile, drop, takeWhile, take, sortBy, sort, catMaybes, mapMaybe, filterM, filter, concat, concatMap, reverse, alterAt, modifyAt, updateAt, deleteAt, insertAt, findLastIndex, findIndex, elemLastIndex, elemIndex, (!!), uncons, unsnoc, init, tail, last, head, insertBy, insert, snoc, null, singleton, fromFoldable, transpose, mapWithIndex, (:))
+import Data.List (List(..), (..), stripPrefix, Pattern(..), length, range, foldM, unzip, zip, zipWithA, zipWith, intersectBy, intersect, (\\), deleteBy, delete, unionBy, union, nubBy, nub, groupBy, group', group, partition, span, dropWhile, drop, takeWhile, take, sortBy, sort, catMaybes, mapMaybe, filterM, filter, concat, concatMap, reverse, alterAt, modifyAt, updateAt, deleteAt, insertAt, findLastIndex, findIndex, elemLastIndex, elemIndex, (!!), uncons, unsnoc, init, tail, last, head, insertBy, insert, snoc, null, singleton, fromFoldable, transpose, mapWithIndex, (:))
 import Data.Maybe (Maybe(..), isNothing, fromJust)
 import Data.Monoid.Additive (Additive(..))
 import Data.NonEmpty ((:|))
@@ -19,6 +19,11 @@ testList :: forall eff. Eff (assert :: ASSERT, console :: CONSOLE | eff) Unit
 testList = do
   let l = fromFoldable
 
+  log "strip prefix"
+  assert $ stripPrefix (Pattern (1:Nil)) (1:2:Nil) == Just (2:Nil)
+  assert $ stripPrefix (Pattern Nil) (1:Nil) == Just (1:Nil)
+  assert $ stripPrefix (Pattern (2:Nil)) (1:Nil) == Nothing
+
   log "singleton should construct an list with a single value"
   assert $ singleton 1 == l [1]
   assert $ singleton "foo" == l ["foo"]