{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}


-- | Snoc-lists: lists where prepending is linear-time, but _appending_ is constant-time.
-- Useful for describing zippers and functional queues/buffers more naturally and safely.
--
-- We call it an `RList` because this is really just a vanilla list, but where
-- the semantics are that the last-added thing (internally cons'ed) is
-- understood to be at the \"end\" of the list.
--
-- WARNING: the `Foldable` instance provides a `Foldable.toList`; this simply unwraps the `RList` rather than reversing it.
-- If you need to convert from revered semantics to forward semantics, use this module's `toList`.
module Data.List.Snoc
  ( RList
  , Tsil
  -- * Introduction and Elimination
  , nil
  , snoc
  , singleton
  , unsnoc
  -- ** Patterns
  , pattern Nil
  , pattern Snoc
  -- * Queries
  , null
  , init
  , last
  -- * Traversal
  , catMaybes
  -- * Conversion
  , toList
  , fromList
  , reverseIn
  , reverseOut
  , toArrayN
  , toSet
  ) where

import Prelude hiding (null,init,last,reverse)

import Control.Applicative(Alternative(..))
import Control.DeepSeq (NFData)
import Data.Bifunctor (first)
import Data.Primitive.Contiguous (Contiguous, Element, SmallArray)
import Data.Set (Set)
import GHC.Generics (Generic)

import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified Data.Primitive.Contiguous as Arr
import qualified Data.Set as Set
import qualified Prelude

-- | This datatype defines snoc-lists: lists with O(1) append and O(n) prepend.
-- Underneath the hood, it is just a plain list, but understood as containing its elements in reverse order.
newtype RList a = RList { RList a -> [a]
unRList :: [a] }
  deriving stock ((forall x. RList a -> Rep (RList a) x)
-> (forall x. Rep (RList a) x -> RList a) -> Generic (RList a)
forall x. Rep (RList a) x -> RList a
forall x. RList a -> Rep (RList a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (RList a) x -> RList a
forall a x. RList a -> Rep (RList a) x
$cto :: forall a x. Rep (RList a) x -> RList a
$cfrom :: forall a x. RList a -> Rep (RList a) x
Generic)
  deriving newtype (a -> RList b -> RList a
(a -> b) -> RList a -> RList b
(forall a b. (a -> b) -> RList a -> RList b)
-> (forall a b. a -> RList b -> RList a) -> Functor RList
forall a b. a -> RList b -> RList a
forall a b. (a -> b) -> RList a -> RList b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RList b -> RList a
$c<$ :: forall a b. a -> RList b -> RList a
fmap :: (a -> b) -> RList a -> RList b
$cfmap :: forall a b. (a -> b) -> RList a -> RList b
Functor,Functor RList
a -> RList a
Functor RList
-> (forall a. a -> RList a)
-> (forall a b. RList (a -> b) -> RList a -> RList b)
-> (forall a b c. (a -> b -> c) -> RList a -> RList b -> RList c)
-> (forall a b. RList a -> RList b -> RList b)
-> (forall a b. RList a -> RList b -> RList a)
-> Applicative RList
RList a -> RList b -> RList b
RList a -> RList b -> RList a
RList (a -> b) -> RList a -> RList b
(a -> b -> c) -> RList a -> RList b -> RList c
forall a. a -> RList a
forall a b. RList a -> RList b -> RList a
forall a b. RList a -> RList b -> RList b
forall a b. RList (a -> b) -> RList a -> RList b
forall a b c. (a -> b -> c) -> RList a -> RList b -> RList c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: RList a -> RList b -> RList a
$c<* :: forall a b. RList a -> RList b -> RList a
*> :: RList a -> RList b -> RList b
$c*> :: forall a b. RList a -> RList b -> RList b
liftA2 :: (a -> b -> c) -> RList a -> RList b -> RList c
$cliftA2 :: forall a b c. (a -> b -> c) -> RList a -> RList b -> RList c
<*> :: RList (a -> b) -> RList a -> RList b
$c<*> :: forall a b. RList (a -> b) -> RList a -> RList b
pure :: a -> RList a
$cpure :: forall a. a -> RList a
$cp1Applicative :: Functor RList
Applicative)
instance (NFData a) => NFData (RList a)

instance (Show a) => Show (RList a) where
  show :: RList a -> String
show = [a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> (RList a -> [a]) -> RList a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RList a -> [a]
forall a. RList a -> [a]
toList
instance (Read a) => Read (RList a) where
  readsPrec :: Int -> ReadS (RList a)
readsPrec Int
i = ((([a], String) -> (RList a, String))
-> [([a], String)] -> [(RList a, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([a], String) -> (RList a, String))
 -> [([a], String)] -> [(RList a, String)])
-> (([a] -> RList a) -> ([a], String) -> (RList a, String))
-> ([a] -> RList a)
-> [([a], String)]
-> [(RList a, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> RList a) -> ([a], String) -> (RList a, String)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first) [a] -> RList a
forall a. [a] -> RList a
fromList ([([a], String)] -> [(RList a, String)])
-> (String -> [([a], String)]) -> ReadS (RList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [([a], String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i

instance Semigroup (RList a) where
  (RList [a]
a) <> :: RList a -> RList a -> RList a
<> (RList [a]
b) = [a] -> RList a
forall a. [a] -> RList a
RList ([a]
b [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
a)
instance Monoid (RList a) where
  mempty :: RList a
mempty = RList a
forall a. RList a
Nil

instance Alternative RList where
  empty :: RList a
empty = RList a
forall a. Monoid a => a
mempty
  (RList [a]
a) <|> :: RList a -> RList a -> RList a
<|> (RList [a]
b) = [a] -> RList a
forall a. [a] -> RList a
RList ([a]
b [a] -> [a] -> [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a]
a)

-- | See? It's \"List\" in reverse?
-- I dunno, I just think 'RList' is an inelegant name, and word-initial @/t͜s/@ is one of my favorite phonemes.
type Tsil = RList

{-# COMPLETE Nil, Snoc #-}

-- | An empty 'RList', such as 'nil'.
pattern Nil :: RList a
pattern $bNil :: RList a
$mNil :: forall r a. RList a -> (Void# -> r) -> (Void# -> r) -> r
Nil = RList []

-- | The 'RList' consisting of initial and last elements, such as created by 'snoc'.
pattern Snoc :: RList a -> a -> RList a
pattern $bSnoc :: RList a -> a -> RList a
$mSnoc :: forall r a. RList a -> (RList a -> a -> r) -> (Void# -> r) -> r
Snoc xs x <- (unsnoc -> Just (xs, x))
  where Snoc = RList a -> a -> RList a
forall a. RList a -> a -> RList a
snoc

-- | The empty 'RList'.
nil :: RList a
{-# INLINABLE nil #-}
nil :: RList a
nil = [a] -> RList a
forall a. [a] -> RList a
RList []

-- | @O(1)@ Append an element.
--
-- If you are looking for @cons@, you should use a plain list, or a finite sequence/queue type.
snoc :: RList a -> a -> RList a
{-# INLINABLE snoc #-}
snoc :: RList a -> a -> RList a
snoc (RList [a]
xs) a
x = [a] -> RList a
forall a. [a] -> RList a
RList (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)

-- | @O(1)@ Access the last element and initial portion of the list.
-- See also 'last' and 'init' if you only need one component.
--
-- If you are looking for @uncons@, you should use a plain list, or a finite sequence/queue type.
unsnoc :: RList a -> Maybe (RList a, a)
{-# INLINABLE unsnoc #-}
unsnoc :: RList a -> Maybe (RList a, a)
unsnoc (RList []) = Maybe (RList a, a)
forall a. Maybe a
Nothing
unsnoc (RList (a
x:[a]
xs)) = (RList a, a) -> Maybe (RList a, a)
forall a. a -> Maybe a
Just ([a] -> RList a
forall a. [a] -> RList a
RList [a]
xs, a
x)

-- | Create a single-element 'RList'.
singleton :: a -> RList a
{-# INLINE singleton #-}
singleton :: a -> RList a
singleton = [a] -> RList a
forall a. [a] -> RList a
RList ([a] -> RList a) -> (a -> [a]) -> a -> RList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[])

-- | Test if an 'RList' is empty.
null :: RList a -> Bool
{-# INLINE null #-}
null :: RList a -> Bool
null (RList [a]
xs) = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [a]
xs

-- | @O(1)@ extract the last element of a list, if it exists.
-- See also 'unsnoc' if you also need 'init' at the same time.
last :: RList a -> Maybe a
last :: RList a -> Maybe a
last RList a
Nil = Maybe a
forall a. Maybe a
Nothing
last (Snoc RList a
_ a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

-- | @O(1)@ extract the elements of a list other than the last, if they exist.
-- See also 'unsnoc' if you also need 'last' at the same time.
init :: RList a -> Maybe (RList a)
init :: RList a -> Maybe (RList a)
init RList a
Nil = Maybe (RList a)
forall a. Maybe a
Nothing
init (Snoc RList a
xs a
_) = RList a -> Maybe (RList a)
forall a. a -> Maybe a
Just RList a
xs

-- | Remove all 'Nothing's from an 'RList' of 'Maybe's.
catMaybes :: RList (Maybe a) -> RList a
{-# INLINE catMaybes #-}
catMaybes :: RList (Maybe a) -> RList a
catMaybes = [a] -> RList a
forall a. [a] -> RList a
RList ([a] -> RList a)
-> (RList (Maybe a) -> [a]) -> RList (Maybe a) -> RList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
Maybe.catMaybes ([Maybe a] -> [a])
-> (RList (Maybe a) -> [Maybe a]) -> RList (Maybe a) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RList (Maybe a) -> [Maybe a]
forall a. RList a -> [a]
unRList

-- | @O(n)@ Convert to a plain list, maintaining order.
--
-- This is here so that you can escape back out to normal cons-list land once
-- you're done building your list.
--
-- See 'reverseOut' for when order doesn't matter.
toList :: RList a -> [a]
{-# INLINE toList #-}
toList :: RList a -> [a]
toList (RList [a]
xs) = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
xs

-- | @O(n)@ Convert from a plain list, maintaining order.
--
-- This is added for completion's sake, as I'm not sure you'll often need this adapter.
--
-- See `toList` for the inverse, or `reverseIn` for when order doesn't matter.
fromList :: [a] -> RList a
{-# INLINE fromList #-}
fromList :: [a] -> RList a
fromList = [a] -> RList a
forall a. [a] -> RList a
RList ([a] -> RList a) -> ([a] -> [a]) -> [a] -> RList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse

-- | @O(0)@ Reverse an `RList`, returning a plain cons list.
--
-- This is here so that when the output list is fed to an order-agnostic
-- function, you don't have to pay the cost of reversing the representation.
--
-- See 'toList' for when order matters.
reverseOut :: RList a -> [a]
{-# INLINE reverseOut #-}
reverseOut :: RList a -> [a]
reverseOut = RList a -> [a]
forall a. RList a -> [a]
unRList


-- | @O(0)@ Reverse a plain cons list, rerutning an `RList`.
--
-- See `reverseOut` for the inverse, and why you might use these.
reverseIn :: [a] -> RList a
{-# INLINE reverseIn #-}
reverseIn :: [a] -> RList a
reverseIn = [a] -> RList a
forall a. [a] -> RList a
RList

-- | Write the contents of the `RList` into an array, assuming you know the length of the array.
-- This is useful in the common case of buffering an unknown-length stream before allocating contiguous space for the elements.
--
-- If you sepcify to small a langth, the initial part of the array will be uninitialized.
-- If you specify to large a length, the initial part of the list will not be written.
--
-- If you are unaware of the size of the list, `Arr.fromList . fromList` will do the trick, but will obviously be slower.
toArrayN :: (Contiguous arr, Element arr a) => Int -> RList a -> arr a
{-# INLINE toArrayN #-} -- use inline instead of inlinable, because inlinable with Contiguous is busted
{-# SPECIALIZE toArrayN :: Int -> RList a -> SmallArray a #-}
toArrayN :: Int -> RList a -> arr a
toArrayN Int
n (RList [a]
xs0) = (forall s. ST s (Mutable arr s a)) -> arr a
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
(forall s. ST s (Mutable arr s a)) -> arr a
Arr.create ((forall s. ST s (Mutable arr s a)) -> arr a)
-> (forall s. ST s (Mutable arr s a)) -> arr a
forall a b. (a -> b) -> a -> b
$ do
  Mutable arr s a
mut <- Int -> ST s (Mutable arr (PrimState (ST s)) a)
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
Arr.new Int
n
  Mutable arr (PrimState (ST s)) a -> Int -> [a] -> ST s ()
forall (arr :: * -> *) b (f :: * -> *).
(Element arr b, Contiguous arr, PrimMonad f) =>
Mutable arr (PrimState f) b -> Int -> [b] -> f ()
loop Mutable arr s a
Mutable arr (PrimState (ST s)) a
mut (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
xs0
  Mutable arr s a -> ST s (Mutable arr s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mutable arr s a
mut
  where
  loop :: Mutable arr (PrimState f) b -> Int -> [b] -> f ()
loop Mutable arr (PrimState f) b
_ (-1) [b]
_ = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  loop Mutable arr (PrimState f) b
_ Int
_ [] = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  loop Mutable arr (PrimState f) b
arr Int
i (b
x:[b]
xs) = do
    Mutable arr (PrimState f) b -> Int -> b -> f ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
Arr.write Mutable arr (PrimState f) b
arr Int
i b
x
    Mutable arr (PrimState f) b -> Int -> [b] -> f ()
loop Mutable arr (PrimState f) b
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [b]
xs

-- | Convert to a set without an intermediate conversion to a cons-list.
toSet :: (Ord a) => RList a -> Set a
{-# INLINABLE toSet #-}
toSet :: RList a -> Set a
toSet (RList [a]
xs) = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs