{-# LANGUAGE CPP #-}
-------------------------------------------------------------------------------
-- |
-- Module      :  Control.Lens.Internal.List
-- Copyright   :  (C) 2014-2016 Edward Kmett and Eric Mertens
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  non-portable
--
-- This module provides utility functions on lists used by the library
-- implementation.
-------------------------------------------------------------------------------
module Control.Lens.Internal.List
  ( ordinalNub
  , stripSuffix
  ) where

import Control.Monad (guard)
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

--- $setup
--- >>> :set -XNoOverloadedStrings
--- >>> import Control.Lens.Internal.List

-- | Return the the subset of given ordinals within a given bound
-- and in order of the first occurrence seen.
--
-- Bound: @0 <= x < l@
--
-- >>> ordinalNub 3 [-1,2,1,4,2,3]
-- [2,1]
ordinalNub ::
  Int   {- ^ strict upper bound -} ->
  [Int] {- ^ ordinals           -} ->
  [Int] {- ^ unique, in-bound ordinals, in order seen -}
ordinalNub :: Int -> [Int] -> [Int]
ordinalNub Int
l [Int]
xs = (Int -> (IntSet -> [Int]) -> IntSet -> [Int])
-> (IntSet -> [Int]) -> [Int] -> IntSet -> [Int]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> (IntSet -> [Int]) -> IntSet -> [Int]
ordinalNubHelper Int
l) ([Int] -> IntSet -> [Int]
forall a b. a -> b -> a
const []) [Int]
xs IntSet
IntSet.empty

ordinalNubHelper :: Int -> Int -> (IntSet -> [Int]) -> (IntSet -> [Int])
ordinalNubHelper :: Int -> Int -> (IntSet -> [Int]) -> IntSet -> [Int]
ordinalNubHelper Int
l Int
x IntSet -> [Int]
next IntSet
seen
  | Bool
outOfBounds Bool -> Bool -> Bool
|| Bool
notUnique = IntSet -> [Int]
next IntSet
seen
  | Bool
otherwise                = Int
x Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: IntSet -> [Int]
next (Int -> IntSet -> IntSet
IntSet.insert Int
x IntSet
seen)
  where
  outOfBounds :: Bool
outOfBounds = Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x
  notUnique :: Bool
notUnique   = Int
x Int -> IntSet -> Bool
`IntSet.member` IntSet
seen

-- | \(\mathcal{O}(\min(m,n))\). The 'stripSuffix' function drops the given
-- suffix from a list. It returns 'Nothing' if the list did not end with the
-- suffix given, or 'Just' the list after the suffix, if it does.
--
-- >>> stripSuffix "bar" "foobar"
-- Just "foo"
--
-- >>> stripSuffix "foo" "foo"
-- Just ""
--
-- >>> stripSuffix "bar" "barfoo"
-- Nothing
--
-- >>> stripSuffix "foo" "barfoobaz"
-- Nothing
stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
stripSuffix :: forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix [a]
qs [a]
xs0 = [a] -> [a] -> Maybe [a]
forall {a}. [a] -> [a] -> Maybe [a]
go [a]
xs0 [a]
zs
  where
    zs :: [a]
zs = [a] -> [a] -> [a]
forall {a} {a}. [a] -> [a] -> [a]
drp [a]
qs [a]
xs0
    drp :: [a] -> [a] -> [a]
drp (a
_:[a]
ps) (a
_:[a]
xs) = [a] -> [a] -> [a]
drp [a]
ps [a]
xs
    drp [] [a]
xs = [a]
xs
    drp [a]
_  [] = []
    go :: [a] -> [a] -> Maybe [a]
go (a
_:[a]
xs) (a
_:[a]
ys) = [a] -> [a] -> Maybe [a]
go [a]
xs [a]
ys
    go [a]
xs [] = (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a b. a -> b -> a
const [a]
xs0 [a]
zs [a] -> Maybe () -> Maybe [a]
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([a]
xs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
qs)
    go [] [a]
_  = Maybe [a]
forall a. Maybe a
Nothing -- impossible
{-# INLINE stripSuffix #-}