{-# 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.
module Data.List.Snoc
  ( Tsil
  , RList
  -- * 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.
--
-- | 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.
newtype Tsil a = Tsil { forall a. Tsil a -> [a]
unTsil :: [a] }
  deriving stock ((forall x. Tsil a -> Rep (Tsil a) x)
-> (forall x. Rep (Tsil a) x -> Tsil a) -> Generic (Tsil a)
forall x. Rep (Tsil a) x -> Tsil a
forall x. Tsil a -> Rep (Tsil a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Tsil a) x -> Tsil a
forall a x. Tsil a -> Rep (Tsil a) x
$cto :: forall a x. Rep (Tsil a) x -> Tsil a
$cfrom :: forall a x. Tsil a -> Rep (Tsil a) x
Generic,Tsil a -> Tsil a -> Bool
(Tsil a -> Tsil a -> Bool)
-> (Tsil a -> Tsil a -> Bool) -> Eq (Tsil a)
forall a. Eq a => Tsil a -> Tsil a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tsil a -> Tsil a -> Bool
$c/= :: forall a. Eq a => Tsil a -> Tsil a -> Bool
== :: Tsil a -> Tsil a -> Bool
$c== :: forall a. Eq a => Tsil a -> Tsil a -> Bool
Eq)
  deriving newtype ((forall a b. (a -> b) -> Tsil a -> Tsil b)
-> (forall a b. a -> Tsil b -> Tsil a) -> Functor Tsil
forall a b. a -> Tsil b -> Tsil a
forall a b. (a -> b) -> Tsil a -> Tsil b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Tsil b -> Tsil a
$c<$ :: forall a b. a -> Tsil b -> Tsil a
fmap :: forall a b. (a -> b) -> Tsil a -> Tsil b
$cfmap :: forall a b. (a -> b) -> Tsil a -> Tsil b
Functor,Functor Tsil
Functor Tsil
-> (forall a. a -> Tsil a)
-> (forall a b. Tsil (a -> b) -> Tsil a -> Tsil b)
-> (forall a b c. (a -> b -> c) -> Tsil a -> Tsil b -> Tsil c)
-> (forall a b. Tsil a -> Tsil b -> Tsil b)
-> (forall a b. Tsil a -> Tsil b -> Tsil a)
-> Applicative Tsil
forall a. a -> Tsil a
forall a b. Tsil a -> Tsil b -> Tsil a
forall a b. Tsil a -> Tsil b -> Tsil b
forall a b. Tsil (a -> b) -> Tsil a -> Tsil b
forall a b c. (a -> b -> c) -> Tsil a -> Tsil b -> Tsil 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
<* :: forall a b. Tsil a -> Tsil b -> Tsil a
$c<* :: forall a b. Tsil a -> Tsil b -> Tsil a
*> :: forall a b. Tsil a -> Tsil b -> Tsil b
$c*> :: forall a b. Tsil a -> Tsil b -> Tsil b
liftA2 :: forall a b c. (a -> b -> c) -> Tsil a -> Tsil b -> Tsil c
$cliftA2 :: forall a b c. (a -> b -> c) -> Tsil a -> Tsil b -> Tsil c
<*> :: forall a b. Tsil (a -> b) -> Tsil a -> Tsil b
$c<*> :: forall a b. Tsil (a -> b) -> Tsil a -> Tsil b
pure :: forall a. a -> Tsil a
$cpure :: forall a. a -> Tsil a
Applicative)
instance (NFData a) => NFData (Tsil a)

instance (Show a) => Show (Tsil a) where
  show :: Tsil a -> String
show = [a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> (Tsil a -> [a]) -> Tsil a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tsil a -> [a]
forall a. Tsil a -> [a]
toList
instance (Read a) => Read (Tsil a) where
  readsPrec :: Int -> ReadS (Tsil a)
readsPrec Int
i = ((([a], String) -> (Tsil a, String))
-> [([a], String)] -> [(Tsil a, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([a], String) -> (Tsil a, String))
 -> [([a], String)] -> [(Tsil a, String)])
-> (([a] -> Tsil a) -> ([a], String) -> (Tsil a, String))
-> ([a] -> Tsil a)
-> [([a], String)]
-> [(Tsil a, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Tsil a) -> ([a], String) -> (Tsil a, String)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first) [a] -> Tsil a
forall a. [a] -> Tsil a
fromList ([([a], String)] -> [(Tsil a, String)])
-> (String -> [([a], String)]) -> ReadS (Tsil 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 Foldable Tsil where
  {-# INLINABLE foldr #-}
  foldr :: forall a b. (a -> b -> b) -> b -> Tsil a -> b
foldr a -> b -> b
_ b
z Tsil a
Nil = b
z
  foldr a -> b -> b
f b
z (Tsil a
xs `Snoc` a
x) = (a -> b -> b) -> b -> Tsil a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f (a
x a -> b -> b
`f` b
z) Tsil a
xs

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

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

-- | I initially went with this boring name for reverse-lists.
-- However, I genuinely would rather write (and pronounce) 'Tsil'.
{-# DEPRECATED RList "Preferred spelling is `Tsil`" #-}
type RList = Tsil

{-# COMPLETE Nil, Snoc #-}

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

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

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

-- | @O(1)@ Append an element.
--
-- If you are looking for @cons@, you should use a plain list, or a finite sequence/queue type.
snoc :: Tsil a -> a -> Tsil a
{-# INLINABLE snoc #-}
snoc :: forall a. Tsil a -> a -> Tsil a
snoc (Tsil [a]
xs) a
x = [a] -> Tsil a
forall a. [a] -> Tsil a
Tsil (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 :: Tsil a -> Maybe (Tsil a, a)
{-# INLINABLE unsnoc #-}
unsnoc :: forall a. Tsil a -> Maybe (Tsil a, a)
unsnoc (Tsil []) = Maybe (Tsil a, a)
forall a. Maybe a
Nothing
unsnoc (Tsil (a
x:[a]
xs)) = (Tsil a, a) -> Maybe (Tsil a, a)
forall a. a -> Maybe a
Just ([a] -> Tsil a
forall a. [a] -> Tsil a
Tsil [a]
xs, a
x)

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

-- | Test if an 'Tsil' is empty.
null :: Tsil a -> Bool
{-# INLINE null #-}
null :: forall a. Tsil a -> Bool
null (Tsil [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 :: Tsil a -> Maybe a
{-# INLINABLE last #-}
last :: forall a. Tsil a -> Maybe a
last Tsil a
Nil = Maybe a
forall a. Maybe a
Nothing
last (Snoc Tsil 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 :: Tsil a -> Maybe (Tsil a)
{-# INLINABLE init #-}
init :: forall a. Tsil a -> Maybe (Tsil a)
init Tsil a
Nil = Maybe (Tsil a)
forall a. Maybe a
Nothing
init (Snoc Tsil a
xs a
_) = Tsil a -> Maybe (Tsil a)
forall a. a -> Maybe a
Just Tsil a
xs

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

-- | @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 :: Tsil a -> [a]
{-# INLINE toList #-}
toList :: forall a. Tsil a -> [a]
toList (Tsil [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] -> Tsil a
{-# INLINE fromList #-}
fromList :: forall a. [a] -> Tsil a
fromList = [a] -> Tsil a
forall a. [a] -> Tsil a
Tsil ([a] -> Tsil a) -> ([a] -> [a]) -> [a] -> Tsil a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse

-- | @O(0)@ Reverse an `Tsil`, 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 :: Tsil a -> [a]
{-# INLINE reverseOut #-}
reverseOut :: forall a. Tsil a -> [a]
reverseOut = Tsil a -> [a]
forall a. Tsil a -> [a]
unTsil


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

-- | Write the contents of the `Tsil` 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 -> Tsil a -> arr a
{-# INLINE toArrayN #-} -- use inline instead of inlinable, because inlinable with Contiguous is busted
{-# SPECIALIZE toArrayN :: Int -> Tsil a -> SmallArray a #-}
toArrayN :: forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
Int -> Tsil a -> arr a
toArrayN Int
n (Tsil [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) => Tsil a -> Set a
{-# INLINABLE toSet #-}
toSet :: forall a. Ord a => Tsil a -> Set a
toSet (Tsil [a]
xs) = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs