{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.LSeq
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
-- Description :  Wrapper around Data.Sequence with type level length annotation.
--
--------------------------------------------------------------------------------
module Data.LSeq( LSeq( EmptyL, (:<|), (:<<), (:|>) )
                , toSeq
                , empty
                , fromList
                , fromNonEmpty
                , fromSeq

                , (<|), (|>)
                , (><)
                , eval

                , index
                , adjust
                , partition
                , mapWithIndex
                , take
                , drop
                , unstableSort, unstableSortBy
                , head, tail, last, init
                , append

                , ViewL(..)
                , viewl

                , ViewR(..)
                , viewr

                , zipWith

                , promise
                , forceLSeq
                ) where

import           Control.DeepSeq
import           Control.Lens ((%~), (&), (<&>), (^?!), bimap)
import           Control.Lens.At (Ixed(..), Index, IxValue)
import           Data.Aeson
import           Data.Coerce(coerce)
import qualified Data.Foldable as F
import           Data.Functor.Apply
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Proxy
import           Data.Semigroup.Foldable
import           Data.Semigroup.Traversable
import qualified Data.Sequence as S
import qualified Data.Traversable as Tr
import           GHC.Generics (Generic)
import           GHC.TypeLits
import           Prelude hiding (drop,take,head,last,tail,init,zipWith)
import           Test.QuickCheck (Arbitrary(..),vector)

--------------------------------------------------------------------------------

-- $setup
-- >>> :{
-- import Data.Proxy
-- :}



-- | LSeq n a certifies that the sequence has *at least* n items
newtype LSeq (n :: Nat) a = LSeq (S.Seq a)
                          deriving (Int -> LSeq n a -> ShowS
[LSeq n a] -> ShowS
LSeq n a -> String
(Int -> LSeq n a -> ShowS)
-> (LSeq n a -> String) -> ([LSeq n a] -> ShowS) -> Show (LSeq n a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: Nat) a. Show a => Int -> LSeq n a -> ShowS
forall (n :: Nat) a. Show a => [LSeq n a] -> ShowS
forall (n :: Nat) a. Show a => LSeq n a -> String
showList :: [LSeq n a] -> ShowS
$cshowList :: forall (n :: Nat) a. Show a => [LSeq n a] -> ShowS
show :: LSeq n a -> String
$cshow :: forall (n :: Nat) a. Show a => LSeq n a -> String
showsPrec :: Int -> LSeq n a -> ShowS
$cshowsPrec :: forall (n :: Nat) a. Show a => Int -> LSeq n a -> ShowS
Show,ReadPrec [LSeq n a]
ReadPrec (LSeq n a)
Int -> ReadS (LSeq n a)
ReadS [LSeq n a]
(Int -> ReadS (LSeq n a))
-> ReadS [LSeq n a]
-> ReadPrec (LSeq n a)
-> ReadPrec [LSeq n a]
-> Read (LSeq n a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (n :: Nat) a. Read a => ReadPrec [LSeq n a]
forall (n :: Nat) a. Read a => ReadPrec (LSeq n a)
forall (n :: Nat) a. Read a => Int -> ReadS (LSeq n a)
forall (n :: Nat) a. Read a => ReadS [LSeq n a]
readListPrec :: ReadPrec [LSeq n a]
$creadListPrec :: forall (n :: Nat) a. Read a => ReadPrec [LSeq n a]
readPrec :: ReadPrec (LSeq n a)
$creadPrec :: forall (n :: Nat) a. Read a => ReadPrec (LSeq n a)
readList :: ReadS [LSeq n a]
$creadList :: forall (n :: Nat) a. Read a => ReadS [LSeq n a]
readsPrec :: Int -> ReadS (LSeq n a)
$creadsPrec :: forall (n :: Nat) a. Read a => Int -> ReadS (LSeq n a)
Read,LSeq n a -> LSeq n a -> Bool
(LSeq n a -> LSeq n a -> Bool)
-> (LSeq n a -> LSeq n a -> Bool) -> Eq (LSeq n a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: Nat) a. Eq a => LSeq n a -> LSeq n a -> Bool
/= :: LSeq n a -> LSeq n a -> Bool
$c/= :: forall (n :: Nat) a. Eq a => LSeq n a -> LSeq n a -> Bool
== :: LSeq n a -> LSeq n a -> Bool
$c== :: forall (n :: Nat) a. Eq a => LSeq n a -> LSeq n a -> Bool
Eq,Eq (LSeq n a)
Eq (LSeq n a)
-> (LSeq n a -> LSeq n a -> Ordering)
-> (LSeq n a -> LSeq n a -> Bool)
-> (LSeq n a -> LSeq n a -> Bool)
-> (LSeq n a -> LSeq n a -> Bool)
-> (LSeq n a -> LSeq n a -> Bool)
-> (LSeq n a -> LSeq n a -> LSeq n a)
-> (LSeq n a -> LSeq n a -> LSeq n a)
-> Ord (LSeq n a)
LSeq n a -> LSeq n a -> Bool
LSeq n a -> LSeq n a -> Ordering
LSeq n a -> LSeq n a -> LSeq n a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (n :: Nat) a. Ord a => Eq (LSeq n a)
forall (n :: Nat) a. Ord a => LSeq n a -> LSeq n a -> Bool
forall (n :: Nat) a. Ord a => LSeq n a -> LSeq n a -> Ordering
forall (n :: Nat) a. Ord a => LSeq n a -> LSeq n a -> LSeq n a
min :: LSeq n a -> LSeq n a -> LSeq n a
$cmin :: forall (n :: Nat) a. Ord a => LSeq n a -> LSeq n a -> LSeq n a
max :: LSeq n a -> LSeq n a -> LSeq n a
$cmax :: forall (n :: Nat) a. Ord a => LSeq n a -> LSeq n a -> LSeq n a
>= :: LSeq n a -> LSeq n a -> Bool
$c>= :: forall (n :: Nat) a. Ord a => LSeq n a -> LSeq n a -> Bool
> :: LSeq n a -> LSeq n a -> Bool
$c> :: forall (n :: Nat) a. Ord a => LSeq n a -> LSeq n a -> Bool
<= :: LSeq n a -> LSeq n a -> Bool
$c<= :: forall (n :: Nat) a. Ord a => LSeq n a -> LSeq n a -> Bool
< :: LSeq n a -> LSeq n a -> Bool
$c< :: forall (n :: Nat) a. Ord a => LSeq n a -> LSeq n a -> Bool
compare :: LSeq n a -> LSeq n a -> Ordering
$ccompare :: forall (n :: Nat) a. Ord a => LSeq n a -> LSeq n a -> Ordering
$cp1Ord :: forall (n :: Nat) a. Ord a => Eq (LSeq n a)
Ord,a -> LSeq n a -> Bool
LSeq n m -> m
LSeq n a -> [a]
LSeq n a -> Bool
LSeq n a -> Int
LSeq n a -> a
LSeq n a -> a
LSeq n a -> a
LSeq n a -> a
(a -> m) -> LSeq n a -> m
(a -> m) -> LSeq n a -> m
(a -> b -> b) -> b -> LSeq n a -> b
(a -> b -> b) -> b -> LSeq n a -> b
(b -> a -> b) -> b -> LSeq n a -> b
(b -> a -> b) -> b -> LSeq n a -> b
(a -> a -> a) -> LSeq n a -> a
(a -> a -> a) -> LSeq n a -> a
(forall m. Monoid m => LSeq n m -> m)
-> (forall m a. Monoid m => (a -> m) -> LSeq n a -> m)
-> (forall m a. Monoid m => (a -> m) -> LSeq n a -> m)
-> (forall a b. (a -> b -> b) -> b -> LSeq n a -> b)
-> (forall a b. (a -> b -> b) -> b -> LSeq n a -> b)
-> (forall b a. (b -> a -> b) -> b -> LSeq n a -> b)
-> (forall b a. (b -> a -> b) -> b -> LSeq n a -> b)
-> (forall a. (a -> a -> a) -> LSeq n a -> a)
-> (forall a. (a -> a -> a) -> LSeq n a -> a)
-> (forall a. LSeq n a -> [a])
-> (forall a. LSeq n a -> Bool)
-> (forall a. LSeq n a -> Int)
-> (forall a. Eq a => a -> LSeq n a -> Bool)
-> (forall a. Ord a => LSeq n a -> a)
-> (forall a. Ord a => LSeq n a -> a)
-> (forall a. Num a => LSeq n a -> a)
-> (forall a. Num a => LSeq n a -> a)
-> Foldable (LSeq n)
forall a. Eq a => a -> LSeq n a -> Bool
forall a. Num a => LSeq n a -> a
forall a. Ord a => LSeq n a -> a
forall m. Monoid m => LSeq n m -> m
forall a. LSeq n a -> Bool
forall a. LSeq n a -> Int
forall a. LSeq n a -> [a]
forall a. (a -> a -> a) -> LSeq n a -> a
forall m a. Monoid m => (a -> m) -> LSeq n a -> m
forall b a. (b -> a -> b) -> b -> LSeq n a -> b
forall a b. (a -> b -> b) -> b -> LSeq n a -> b
forall (n :: Nat) a. Eq a => a -> LSeq n a -> Bool
forall (n :: Nat) a. Num a => LSeq n a -> a
forall (n :: Nat) a. Ord a => LSeq n a -> a
forall (n :: Nat) m. Monoid m => LSeq n m -> m
forall (n :: Nat) a. LSeq n a -> Bool
forall (n :: Nat) a. LSeq n a -> Int
forall (n :: Nat) a. LSeq n a -> [a]
forall (n :: Nat) a. (a -> a -> a) -> LSeq n a -> a
forall (n :: Nat) m a. Monoid m => (a -> m) -> LSeq n a -> m
forall (n :: Nat) b a. (b -> a -> b) -> b -> LSeq n a -> b
forall (n :: Nat) a b. (a -> b -> b) -> b -> LSeq n a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: LSeq n a -> a
$cproduct :: forall (n :: Nat) a. Num a => LSeq n a -> a
sum :: LSeq n a -> a
$csum :: forall (n :: Nat) a. Num a => LSeq n a -> a
minimum :: LSeq n a -> a
$cminimum :: forall (n :: Nat) a. Ord a => LSeq n a -> a
maximum :: LSeq n a -> a
$cmaximum :: forall (n :: Nat) a. Ord a => LSeq n a -> a
elem :: a -> LSeq n a -> Bool
$celem :: forall (n :: Nat) a. Eq a => a -> LSeq n a -> Bool
length :: LSeq n a -> Int
$clength :: forall (n :: Nat) a. LSeq n a -> Int
null :: LSeq n a -> Bool
$cnull :: forall (n :: Nat) a. LSeq n a -> Bool
toList :: LSeq n a -> [a]
$ctoList :: forall (n :: Nat) a. LSeq n a -> [a]
foldl1 :: (a -> a -> a) -> LSeq n a -> a
$cfoldl1 :: forall (n :: Nat) a. (a -> a -> a) -> LSeq n a -> a
foldr1 :: (a -> a -> a) -> LSeq n a -> a
$cfoldr1 :: forall (n :: Nat) a. (a -> a -> a) -> LSeq n a -> a
foldl' :: (b -> a -> b) -> b -> LSeq n a -> b
$cfoldl' :: forall (n :: Nat) b a. (b -> a -> b) -> b -> LSeq n a -> b
foldl :: (b -> a -> b) -> b -> LSeq n a -> b
$cfoldl :: forall (n :: Nat) b a. (b -> a -> b) -> b -> LSeq n a -> b
foldr' :: (a -> b -> b) -> b -> LSeq n a -> b
$cfoldr' :: forall (n :: Nat) a b. (a -> b -> b) -> b -> LSeq n a -> b
foldr :: (a -> b -> b) -> b -> LSeq n a -> b
$cfoldr :: forall (n :: Nat) a b. (a -> b -> b) -> b -> LSeq n a -> b
foldMap' :: (a -> m) -> LSeq n a -> m
$cfoldMap' :: forall (n :: Nat) m a. Monoid m => (a -> m) -> LSeq n a -> m
foldMap :: (a -> m) -> LSeq n a -> m
$cfoldMap :: forall (n :: Nat) m a. Monoid m => (a -> m) -> LSeq n a -> m
fold :: LSeq n m -> m
$cfold :: forall (n :: Nat) m. Monoid m => LSeq n m -> m
Foldable,a -> LSeq n b -> LSeq n a
(a -> b) -> LSeq n a -> LSeq n b
(forall a b. (a -> b) -> LSeq n a -> LSeq n b)
-> (forall a b. a -> LSeq n b -> LSeq n a) -> Functor (LSeq n)
forall a b. a -> LSeq n b -> LSeq n a
forall a b. (a -> b) -> LSeq n a -> LSeq n b
forall (n :: Nat) a b. a -> LSeq n b -> LSeq n a
forall (n :: Nat) a b. (a -> b) -> LSeq n a -> LSeq n b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LSeq n b -> LSeq n a
$c<$ :: forall (n :: Nat) a b. a -> LSeq n b -> LSeq n a
fmap :: (a -> b) -> LSeq n a -> LSeq n b
$cfmap :: forall (n :: Nat) a b. (a -> b) -> LSeq n a -> LSeq n b
Functor,Functor (LSeq n)
Foldable (LSeq n)
Functor (LSeq n)
-> Foldable (LSeq n)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> LSeq n a -> f (LSeq n b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    LSeq n (f a) -> f (LSeq n a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> LSeq n a -> m (LSeq n b))
-> (forall (m :: * -> *) a.
    Monad m =>
    LSeq n (m a) -> m (LSeq n a))
-> Traversable (LSeq n)
(a -> f b) -> LSeq n a -> f (LSeq n b)
forall (n :: Nat). Functor (LSeq n)
forall (n :: Nat). Foldable (LSeq n)
forall (n :: Nat) (m :: * -> *) a.
Monad m =>
LSeq n (m a) -> m (LSeq n a)
forall (n :: Nat) (f :: * -> *) a.
Applicative f =>
LSeq n (f a) -> f (LSeq n a)
forall (n :: Nat) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LSeq n a -> m (LSeq n b)
forall (n :: Nat) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LSeq n a -> f (LSeq n b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => LSeq n (m a) -> m (LSeq n a)
forall (f :: * -> *) a.
Applicative f =>
LSeq n (f a) -> f (LSeq n a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LSeq n a -> m (LSeq n b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LSeq n a -> f (LSeq n b)
sequence :: LSeq n (m a) -> m (LSeq n a)
$csequence :: forall (n :: Nat) (m :: * -> *) a.
Monad m =>
LSeq n (m a) -> m (LSeq n a)
mapM :: (a -> m b) -> LSeq n a -> m (LSeq n b)
$cmapM :: forall (n :: Nat) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LSeq n a -> m (LSeq n b)
sequenceA :: LSeq n (f a) -> f (LSeq n a)
$csequenceA :: forall (n :: Nat) (f :: * -> *) a.
Applicative f =>
LSeq n (f a) -> f (LSeq n a)
traverse :: (a -> f b) -> LSeq n a -> f (LSeq n b)
$ctraverse :: forall (n :: Nat) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LSeq n a -> f (LSeq n b)
$cp2Traversable :: forall (n :: Nat). Foldable (LSeq n)
$cp1Traversable :: forall (n :: Nat). Functor (LSeq n)
Traversable
                                   ,(forall x. LSeq n a -> Rep (LSeq n a) x)
-> (forall x. Rep (LSeq n a) x -> LSeq n a) -> Generic (LSeq n a)
forall x. Rep (LSeq n a) x -> LSeq n a
forall x. LSeq n a -> Rep (LSeq n a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: Nat) a x. Rep (LSeq n a) x -> LSeq n a
forall (n :: Nat) a x. LSeq n a -> Rep (LSeq n a) x
$cto :: forall (n :: Nat) a x. Rep (LSeq n a) x -> LSeq n a
$cfrom :: forall (n :: Nat) a x. LSeq n a -> Rep (LSeq n a) x
Generic,LSeq n a -> ()
(LSeq n a -> ()) -> NFData (LSeq n a)
forall a. (a -> ()) -> NFData a
forall (n :: Nat) a. NFData a => LSeq n a -> ()
rnf :: LSeq n a -> ()
$crnf :: forall (n :: Nat) a. NFData a => LSeq n a -> ()
NFData)

-- | \( O(1) \) Convert to a sequence by dropping the type-level size.
toSeq          :: LSeq n a -> S.Seq a
toSeq :: LSeq n a -> Seq a
toSeq (LSeq Seq a
s) = Seq a
s

instance Semigroup (LSeq n a) where
  (LSeq Seq a
s) <> :: LSeq n a -> LSeq n a -> LSeq n a
<> (LSeq Seq a
s') = Seq a -> LSeq n a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq (Seq a
s Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
<> Seq a
s')

instance Monoid (LSeq 0 a) where
  mempty :: LSeq 0 a
mempty = LSeq 0 a
forall a. LSeq 0 a
empty
  mappend :: LSeq 0 a -> LSeq 0 a -> LSeq 0 a
mappend = LSeq 0 a -> LSeq 0 a -> LSeq 0 a
forall a. Semigroup a => a -> a -> a
(<>)

instance (KnownNat n, Arbitrary a) => Arbitrary (LSeq n a) where
  arbitrary :: Gen (LSeq n a)
arbitrary = (\[a]
s [a]
s' -> LSeq 0 a -> LSeq n a
forall (m :: Nat) (n :: Nat) a. LSeq m a -> LSeq n a
promise (LSeq 0 a -> LSeq n a) -> ([a] -> LSeq 0 a) -> [a] -> LSeq n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> LSeq 0 a
forall (f :: * -> *) a. Foldable f => f a -> LSeq 0 a
fromList ([a] -> LSeq n a) -> [a] -> LSeq n a
forall a b. (a -> b) -> a -> b
$ [a]
s [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
s')
            ([a] -> [a] -> LSeq n a) -> Gen [a] -> Gen ([a] -> LSeq n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [a]
forall a. Arbitrary a => Int -> Gen [a]
vector (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (Proxy n -> Integer) -> Proxy n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n -> Int) -> Proxy n -> Int
forall a b. (a -> b) -> a -> b
$ (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n))
            Gen ([a] -> LSeq n a) -> Gen [a] -> Gen (LSeq n a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [a]
forall a. Arbitrary a => Gen a
arbitrary

instance ToJSON a => ToJSON (LSeq n a) where
    toEncoding :: LSeq n a -> Encoding
toEncoding = Options -> LSeq n a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance FromJSON a => FromJSON (LSeq n a)


type instance Index   (LSeq n a) = Int
type instance IxValue (LSeq n a) = a
instance Ixed (LSeq n a) where
  ix :: Index (LSeq n a) -> Traversal' (LSeq n a) (IxValue (LSeq n a))
ix Index (LSeq n a)
i IxValue (LSeq n a) -> f (IxValue (LSeq n a))
f s :: LSeq n a
s@(LSeq Seq a
xs)
    | Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
Index (LSeq n a)
i Bool -> Bool -> Bool
&& Int
Index (LSeq n a)
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq a -> Int
forall a. Seq a -> Int
S.length Seq a
xs = IxValue (LSeq n a) -> f (IxValue (LSeq n a))
f (Seq a -> Int -> a
forall a. Seq a -> Int -> a
S.index Seq a
xs Int
Index (LSeq n a)
i) f a -> (a -> LSeq n a) -> f (LSeq n a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
x -> Seq a -> LSeq n a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq (Seq a -> LSeq n a) -> Seq a -> LSeq n a
forall a b. (a -> b) -> a -> b
$ Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
S.update Int
Index (LSeq n a)
i a
x Seq a
xs
    | Bool
otherwise                 = LSeq n a -> f (LSeq n a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LSeq n a
s

instance (1 <= n) => Foldable1 (LSeq n)
instance (1 <= n) => Traversable1 (LSeq n) where
  traverse1 :: (a -> f b) -> LSeq n a -> f (LSeq n b)
traverse1 a -> f b
f (LSeq Seq a
xs) = case MaybeApply f (Seq b) -> Either (f (Seq b)) (Seq b)
forall (f :: * -> *) a. MaybeApply f a -> Either (f a) a
runMaybeApply (MaybeApply f (Seq b) -> Either (f (Seq b)) (Seq b))
-> MaybeApply f (Seq b) -> Either (f (Seq b)) (Seq b)
forall a b. (a -> b) -> a -> b
$ (a -> MaybeApply f b) -> Seq a -> MaybeApply f (Seq b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Either (f b) b -> MaybeApply f b
forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (Either (f b) b -> MaybeApply f b)
-> (a -> Either (f b) b) -> a -> MaybeApply f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f b -> Either (f b) b
forall a b. a -> Either a b
Left (f b -> Either (f b) b) -> (a -> f b) -> a -> Either (f b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) Seq a
xs of
                            Left f (Seq b)
xs' -> Seq b -> LSeq n b
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq (Seq b -> LSeq n b) -> f (Seq b) -> f (LSeq n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Seq b)
xs'
                            Right Seq b
_  -> String -> f (LSeq n b)
forall a. HasCallStack => String -> a
error String
"Data.LSeq.traverse1: impossible"

-- | \( O(1) \) The empty sequence.
empty :: LSeq 0 a
empty :: LSeq 0 a
empty = Seq a -> LSeq 0 a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq Seq a
forall a. Seq a
S.empty

-- | \( O(1) \) Add an element to the left end of a sequence.
--   Mnemonic: a triangle with the single element at the pointy end.
(<|) :: a -> LSeq n a -> LSeq (1 + n) a
a
x <| :: a -> LSeq n a -> LSeq (1 + n) a
<| LSeq n a
xs = Seq a -> LSeq (1 + n) a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq (a
x a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
S.<| LSeq n a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq LSeq n a
xs)

-- | \( O(1) \) Add an element to the right end of a sequence.
--   Mnemonic: a triangle with the single element at the pointy end.
(|>)    :: LSeq n a -> a -> LSeq (1 + n) a
LSeq n a
xs |> :: LSeq n a -> a -> LSeq (1 + n) a
|> a
x = Seq a -> LSeq (1 + n) a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq (LSeq n a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq LSeq n a
xs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
S.|> a
x)

infixr 5 <|
infixl 5 |>

-- | \( O(log(min(n,m))) \) Concatenate two sequences.
(><) :: LSeq n a -> LSeq m a -> LSeq (n + m) a
LSeq n a
xs >< :: LSeq n a -> LSeq m a -> LSeq (n + m) a
>< LSeq m a
ys = Seq a -> LSeq (n + m) a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq (LSeq n a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq LSeq n a
xs Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
<> LSeq m a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq LSeq m a
ys)

infix 5 ><

-- | \( O(1) \) Prove a sequence has at least @n@ elements.
--
-- >>> eval (Proxy :: Proxy 3) (fromList [1,2,3])
-- Just (LSeq (fromList [1,2,3]))
-- >>> eval (Proxy :: Proxy 3) (fromList [1,2])
-- Nothing
-- >>> eval (Proxy :: Proxy 3) (fromList [1..10])
-- Just (LSeq (fromList [1,2,3,4,5,6,7,8,9,10]))
eval :: forall proxy n m a. KnownNat n => proxy n -> LSeq m a -> Maybe (LSeq n a)
eval :: proxy n -> LSeq m a -> Maybe (LSeq n a)
eval proxy n
n (LSeq Seq a
xs)
  | Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Seq a -> Int
forall a. Seq a -> Int
S.length Seq a
xs) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal proxy n
n = LSeq n a -> Maybe (LSeq n a)
forall a. a -> Maybe a
Just (LSeq n a -> Maybe (LSeq n a)) -> LSeq n a -> Maybe (LSeq n a)
forall a b. (a -> b) -> a -> b
$ Seq a -> LSeq n a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq Seq a
xs
  | Bool
otherwise                           = Maybe (LSeq n a)
forall a. Maybe a
Nothing





-- | Promises that the length of this LSeq is actually n. This is not
-- checked.
--
-- This function should be a noop
promise :: forall m n a. LSeq m a -> LSeq n a
promise :: LSeq m a -> LSeq n a
promise = LSeq m a -> LSeq n a
coerce


-- | Forces the first n elements of the LSeq
forceLSeq   :: KnownNat n => proxy n -> LSeq m a -> LSeq n a
forceLSeq :: proxy n -> LSeq m a -> LSeq n a
forceLSeq proxy n
n = LSeq m a -> LSeq n a
forall (m :: Nat) (n :: Nat) a. LSeq m a -> LSeq n a
promise (LSeq m a -> LSeq n a)
-> (LSeq m a -> LSeq m a) -> LSeq m a -> LSeq n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> LSeq m a -> LSeq m a
forall (m :: Nat) a. Int -> LSeq m a -> LSeq m a
go (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal proxy n
n)
  where
    -- forces the Lseq for n' positions
    go                    :: Int -> LSeq m a -> LSeq m a
    go :: Int -> LSeq m a -> LSeq m a
go !Int
n' LSeq m a
s | Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l    = LSeq m a
s
             | Bool
otherwise  = String -> LSeq m a
forall a. HasCallStack => String -> a
error String
msg
      where
        !l :: Int
l  = Seq a -> Int
forall a. Seq a -> Int
S.length (Seq a -> Int) -> (LSeq m a -> Seq a) -> LSeq m a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
S.take Int
n' (Seq a -> Seq a) -> (LSeq m a -> Seq a) -> LSeq m a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSeq m a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq (LSeq m a -> Int) -> LSeq m a -> Int
forall a b. (a -> b) -> a -> b
$ LSeq m a
s
        msg :: String
msg = String
"forceLSeq: too few elements. expected " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" but found " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
l


-- | appends two sequences.
--
append         :: LSeq n a -> LSeq m a -> LSeq (n + m) a
LSeq n a
sa append :: LSeq n a -> LSeq m a -> LSeq (n + m) a
`append` LSeq m a
sb = Seq a -> LSeq (n + m) a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq (Seq a -> LSeq (n + m) a) -> Seq a -> LSeq (n + m) a
forall a b. (a -> b) -> a -> b
$ LSeq n a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq LSeq n a
sa Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
<> LSeq m a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq LSeq m a
sb

--------------------------------------------------------------------------------

-- | \( O(log(min(i,n-i))) \)
--   Get the element with index i, counting from the left and starting at 0.
index     :: LSeq n a -> Int -> a
index :: LSeq n a -> Int -> a
index LSeq n a
s Int
i = LSeq n a
sLSeq n a -> Getting (Endo a) (LSeq n a) a -> a
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!Index (LSeq n a) -> Traversal' (LSeq n a) (IxValue (LSeq n a))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (LSeq n a)
i

-- | \( O(log(min(i,n−i))) \) Update the element at the specified position. If the
--   position is out of range, the original sequence is returned. adjust can lead
--   to poor performance and even memory leaks, because it does not force the new
--   value before installing it in the sequence. adjust' should usually be preferred.
adjust       :: (a -> a) -> Int -> LSeq n a -> LSeq n a
adjust :: (a -> a) -> Int -> LSeq n a -> LSeq n a
adjust a -> a
f Int
i LSeq n a
s = LSeq n a
sLSeq n a -> (LSeq n a -> LSeq n a) -> LSeq n a
forall a b. a -> (a -> b) -> b
&Index (LSeq n a) -> Traversal' (LSeq n a) (IxValue (LSeq n a))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (LSeq n a)
i ((a -> Identity a) -> LSeq n a -> Identity (LSeq n a))
-> (a -> a) -> LSeq n a -> LSeq n a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ a -> a
f

-- | \( O(n) \) The partition function takes a predicate p and a sequence xs and
--   returns sequences of those elements which do and do not satisfy the predicate.
partition   :: (a -> Bool) -> LSeq n a -> (LSeq 0 a, LSeq 0 a)
partition :: (a -> Bool) -> LSeq n a -> (LSeq 0 a, LSeq 0 a)
partition a -> Bool
p = (Seq a -> LSeq 0 a)
-> (Seq a -> LSeq 0 a) -> (Seq a, Seq a) -> (LSeq 0 a, LSeq 0 a)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Seq a -> LSeq 0 a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq Seq a -> LSeq 0 a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq ((Seq a, Seq a) -> (LSeq 0 a, LSeq 0 a))
-> (LSeq n a -> (Seq a, Seq a)) -> LSeq n a -> (LSeq 0 a, LSeq 0 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
S.partition a -> Bool
p (Seq a -> (Seq a, Seq a))
-> (LSeq n a -> Seq a) -> LSeq n a -> (Seq a, Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSeq n a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq

-- | A generalization of 'fmap', 'mapWithIndex' takes a mapping
-- function that also depends on the element's index, and applies it to every
-- element in the sequence.
mapWithIndex   :: (Int -> a -> b) -> LSeq n a -> LSeq n b
mapWithIndex :: (Int -> a -> b) -> LSeq n a -> LSeq n b
mapWithIndex Int -> a -> b
f = (Seq a -> Seq b) -> LSeq n a -> LSeq n b
forall a b (n :: Nat) (m :: Nat).
(Seq a -> Seq b) -> LSeq n a -> LSeq m b
wrapUnsafe ((Int -> a -> b) -> Seq a -> Seq b
forall a b. (Int -> a -> b) -> Seq a -> Seq b
S.mapWithIndex Int -> a -> b
f)

-- | \( O(\log(\min(i,n-i))) \). The first @i@ elements of a sequence.
-- If @i@ is negative, @'take' i s@ yields the empty sequence.
-- If the sequence contains fewer than @i@ elements, the whole sequence
-- is returned.
take   :: Int -> LSeq n a -> LSeq 0 a
take :: Int -> LSeq n a -> LSeq 0 a
take Int
i = (Seq a -> Seq a) -> LSeq n a -> LSeq 0 a
forall a b (n :: Nat) (m :: Nat).
(Seq a -> Seq b) -> LSeq n a -> LSeq m b
wrapUnsafe (Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
S.take Int
i)

-- | \( O(\log(\min(i,n-i))) \). Elements of a sequence after the first @i@.
-- If @i@ is negative, @'drop' i s@ yields the whole sequence.
-- If the sequence contains fewer than @i@ elements, the empty sequence
-- is returned.
drop   :: Int -> LSeq n a -> LSeq 0 a
drop :: Int -> LSeq n a -> LSeq 0 a
drop Int
i = (Seq a -> Seq a) -> LSeq n a -> LSeq 0 a
forall a b (n :: Nat) (m :: Nat).
(Seq a -> Seq b) -> LSeq n a -> LSeq m b
wrapUnsafe (Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
S.drop Int
i)

-- | \( O(n \log n) \).  A generalization of 'unstableSort', 'unstableSortBy'
-- takes an arbitrary comparator and sorts the specified sequence.
-- The sort is not stable.  This algorithm is frequently faster and
-- uses less memory than 'Data.Sequence.sortBy'.
unstableSortBy   :: (a -> a -> Ordering) -> LSeq n a -> LSeq n a
unstableSortBy :: (a -> a -> Ordering) -> LSeq n a -> LSeq n a
unstableSortBy a -> a -> Ordering
f = (Seq a -> Seq a) -> LSeq n a -> LSeq n a
forall a b (n :: Nat) (m :: Nat).
(Seq a -> Seq b) -> LSeq n a -> LSeq m b
wrapUnsafe ((a -> a -> Ordering) -> Seq a -> Seq a
forall a. (a -> a -> Ordering) -> Seq a -> Seq a
S.unstableSortBy a -> a -> Ordering
f)

-- | \( O(n \log n) \).  'unstableSort' sorts the specified 'LSeq' by
-- the natural ordering of its elements, but the sort is not stable.
-- This algorithm is frequently faster and uses less memory than 'Data.Sequence.sort'.
unstableSort :: Ord a => LSeq n a -> LSeq n a
unstableSort :: LSeq n a -> LSeq n a
unstableSort = (Seq a -> Seq a) -> LSeq n a -> LSeq n a
forall a b (n :: Nat) (m :: Nat).
(Seq a -> Seq b) -> LSeq n a -> LSeq m b
wrapUnsafe Seq a -> Seq a
forall a. Ord a => Seq a -> Seq a
S.unstableSort


wrapUnsafe :: (S.Seq a -> S.Seq b) -> LSeq n a -> LSeq m b
wrapUnsafe :: (Seq a -> Seq b) -> LSeq n a -> LSeq m b
wrapUnsafe Seq a -> Seq b
f = Seq b -> LSeq m b
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq (Seq b -> LSeq m b) -> (LSeq n a -> Seq b) -> LSeq n a -> LSeq m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> Seq b
f (Seq a -> Seq b) -> (LSeq n a -> Seq a) -> LSeq n a -> Seq b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSeq n a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq

--------------------------------------------------------------------------------

-- | \( O(n) \). Create an l-sequence from a sequence of elements.
fromSeq :: S.Seq a -> LSeq 0 a
fromSeq :: Seq a -> LSeq 0 a
fromSeq = Seq a -> LSeq 0 a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq

-- | \( O(n) \). Create an l-sequence from a finite list of elements.
fromList :: Foldable f => f a -> LSeq 0 a
fromList :: f a -> LSeq 0 a
fromList = Seq a -> LSeq 0 a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq (Seq a -> LSeq 0 a) -> (f a -> Seq a) -> f a -> LSeq 0 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Seq a
forall a. [a] -> Seq a
S.fromList ([a] -> Seq a) -> (f a -> [a]) -> f a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

-- | \( O(n) \). Create an l-sequence from a non-empty list.
fromNonEmpty :: NonEmpty.NonEmpty a -> LSeq 1 a
fromNonEmpty :: NonEmpty a -> LSeq 1 a
fromNonEmpty = Seq a -> LSeq 1 a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq (Seq a -> LSeq 1 a)
-> (NonEmpty a -> Seq a) -> NonEmpty a -> LSeq 1 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Seq a
forall a. [a] -> Seq a
S.fromList ([a] -> Seq a) -> (NonEmpty a -> [a]) -> NonEmpty a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList


--------------------------------------------------------------------------------

-- | View of the left end of a sequence.
data ViewL n a where
  (:<) :: a -> LSeq n a -> ViewL (1 + n) a

infixr 5 :<

instance Semigroup (ViewL n a) where
  (a
x :< LSeq n a
xs) <> :: ViewL n a -> ViewL n a -> ViewL n a
<> (a
y :< LSeq n a
ys) = a
x a -> LSeq n a -> ViewL (1 + n) a
forall a (n :: Nat). a -> LSeq n a -> ViewL (1 + n) a
:< Seq a -> LSeq n a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq (LSeq n a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq LSeq n a
xs Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
<> (a
y a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
S.<| LSeq n a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq LSeq n a
ys))

deriving instance Show a => Show (ViewL n a)
instance Functor (ViewL n) where
  fmap :: (a -> b) -> ViewL n a -> ViewL n b
fmap = (a -> b) -> ViewL n a -> ViewL n b
forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
Tr.fmapDefault
instance Foldable (ViewL n) where
  foldMap :: (a -> m) -> ViewL n a -> m
foldMap = (a -> m) -> ViewL n a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
Tr.foldMapDefault
instance Traversable (ViewL n) where
  traverse :: (a -> f b) -> ViewL n a -> f (ViewL n b)
traverse a -> f b
f (a
x :< LSeq n a
xs) = b -> LSeq n b -> ViewL n b
forall a (n :: Nat). a -> LSeq n a -> ViewL (1 + n) a
(:<) (b -> LSeq n b -> ViewL n b) -> f b -> f (LSeq n b -> ViewL n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x f (LSeq n b -> ViewL n b) -> f (LSeq n b) -> f (ViewL n b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> LSeq n a -> f (LSeq n b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f LSeq n a
xs
instance (1 <= n) => Foldable1 (ViewL n)
instance (1 <= n) => Traversable1 (ViewL n) where
  traverse1 :: (a -> f b) -> ViewL n a -> f (ViewL n b)
traverse1 a -> f b
f (a
a :< LSeq Seq a
as) = (\(b
b :< LSeq n b
bs) -> b
b b -> LSeq n b -> ViewL (1 + n) b
forall a (n :: Nat). a -> LSeq n a -> ViewL (1 + n) a
:< LSeq n b -> LSeq n b
forall (m :: Nat) (n :: Nat) a. LSeq m a -> LSeq n a
promise LSeq n b
bs) (ViewL 1 b -> ViewL n b) -> f (ViewL 1 b) -> f (ViewL n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Seq a -> f (ViewL 1 b)
go a
a Seq a
as
    where
      go :: a -> Seq a -> f (ViewL 1 b)
go a
x = \case
        Seq a
S.Empty       -> (b -> LSeq 0 b -> ViewL (1 + 0) b
forall a (n :: Nat). a -> LSeq n a -> ViewL (1 + n) a
:< LSeq 0 b
forall a. LSeq 0 a
empty) (b -> ViewL 1 b) -> f b -> f (ViewL 1 b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
        (a
y S.:<| Seq a
ys) -> (\b
x' (b
y' :< LSeq n b
ys') -> b
x' b -> LSeq 0 b -> ViewL (1 + 0) b
forall a (n :: Nat). a -> LSeq n a -> ViewL (1 + n) a
:< LSeq 1 b -> LSeq 0 b
forall (m :: Nat) (n :: Nat) a. LSeq m a -> LSeq n a
promise @1 @0 (b
y' b -> LSeq n b -> LSeq (1 + n) b
forall a (n :: Nat). a -> LSeq n a -> LSeq (1 + n) a
:<| LSeq n b
ys'))
                        (b -> ViewL 1 b -> ViewL 1 b) -> f b -> f (ViewL 1 b -> ViewL 1 b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x f (ViewL 1 b -> ViewL 1 b) -> f (ViewL 1 b) -> f (ViewL 1 b)
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> a -> Seq a -> f (ViewL 1 b)
go a
y Seq a
ys

instance Eq a => Eq (ViewL n a) where
  ViewL n a
s == :: ViewL n a -> ViewL n a -> Bool
== ViewL n a
s' = ViewL n a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList ViewL n a
s [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== ViewL n a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList ViewL n a
s'
instance Ord a => Ord (ViewL n a) where
  ViewL n a
s compare :: ViewL n a -> ViewL n a -> Ordering
`compare` ViewL n a
s' = ViewL n a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList ViewL n a
s [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ViewL n a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList ViewL n a
s'

-- | \( O(1) )\. Analyse the left end of a sequence.
viewl :: LSeq (1 + n) a -> ViewL (1 + n) a
viewl :: LSeq (1 + n) a -> ViewL (1 + n) a
viewl LSeq (1 + n) a
xs = let ~(a
x S.:< Seq a
ys) = Seq a -> ViewL a
forall a. Seq a -> ViewL a
S.viewl (Seq a -> ViewL a) -> Seq a -> ViewL a
forall a b. (a -> b) -> a -> b
$ LSeq (1 + n) a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq LSeq (1 + n) a
xs in a
x a -> LSeq n a -> ViewL (1 + n) a
forall a (n :: Nat). a -> LSeq n a -> ViewL (1 + n) a
:< Seq a -> LSeq n a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq Seq a
ys

viewl'    :: LSeq (1 + n) a -> (a, LSeq n a)
viewl' :: LSeq (1 + n) a -> (a, LSeq n a)
viewl' LSeq (1 + n) a
xs = let ~(a
x S.:< Seq a
ys) = Seq a -> ViewL a
forall a. Seq a -> ViewL a
S.viewl (Seq a -> ViewL a) -> Seq a -> ViewL a
forall a b. (a -> b) -> a -> b
$ LSeq (1 + n) a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq LSeq (1 + n) a
xs in (a
x,Seq a -> LSeq n a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq Seq a
ys)

infixr 5 :<|

-- | A bidirectional pattern synonym viewing the front of a non-empty
-- sequence.
pattern (:<|)    :: a -> LSeq n a -> LSeq (1 + n) a
pattern x $b:<| :: a -> LSeq n a -> LSeq (1 + n) a
$m:<| :: forall r a (n :: Nat).
LSeq (1 + n) a -> (a -> LSeq n a -> r) -> (Void# -> r) -> r
:<| xs <- (viewl' -> (x,xs)) -- we need the coerce unfortunately
  where
    a
x :<| LSeq n a
xs = a
x a -> LSeq n a -> LSeq (1 + n) a
forall a (n :: Nat). a -> LSeq n a -> LSeq (1 + n) a
<| LSeq n a
xs
{-# COMPLETE (:<|) #-}



infixr 5 :<<

-- | A unidirectional pattern synonym viewing the front of a non-empty
-- sequence.
pattern (:<<)    :: a -> LSeq 0 a -> LSeq n a
pattern x $m:<< :: forall r a (n :: Nat).
LSeq n a -> (a -> LSeq 0 a -> r) -> (Void# -> r) -> r
:<< xs <- (viewLSeq -> Just (x,xs))

-- | The empty sequence.
pattern EmptyL   :: LSeq n a
pattern $mEmptyL :: forall r (n :: Nat) a.
LSeq n a -> (Void# -> r) -> (Void# -> r) -> r
EmptyL   <- (viewLSeq -> Nothing)

viewLSeq          :: LSeq n a -> Maybe (a,LSeq 0 a)
viewLSeq :: LSeq n a -> Maybe (a, LSeq 0 a)
viewLSeq (LSeq Seq a
s) = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
S.viewl Seq a
s of
                      ViewL a
S.EmptyL    -> Maybe (a, LSeq 0 a)
forall a. Maybe a
Nothing
                      (a
x S.:< Seq a
xs) -> (a, LSeq 0 a) -> Maybe (a, LSeq 0 a)
forall a. a -> Maybe a
Just (a
x,Seq a -> LSeq 0 a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq Seq a
xs)


--------------------------------------------------------------------------------

-- | View of the right end of a sequence.
data ViewR n a where
  (:>) :: LSeq n a -> a -> ViewR (1 + n) a

infixl 5 :>

instance Semigroup (ViewR n a) where
  (LSeq n a
xs :> a
x) <> :: ViewR n a -> ViewR n a -> ViewR n a
<> (LSeq n a
ys :> a
y) = Seq a -> LSeq n a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq ((LSeq n a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq LSeq n a
xs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
S.|> a
x) Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
<> LSeq n a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq LSeq n a
ys) LSeq n a -> a -> ViewR (1 + n) a
forall (n :: Nat) a. LSeq n a -> a -> ViewR (1 + n) a
:> a
y

deriving instance Show a => Show (ViewR n a)
instance Functor (ViewR n) where
  fmap :: (a -> b) -> ViewR n a -> ViewR n b
fmap = (a -> b) -> ViewR n a -> ViewR n b
forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
Tr.fmapDefault
instance Foldable (ViewR n) where
  foldMap :: (a -> m) -> ViewR n a -> m
foldMap = (a -> m) -> ViewR n a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
Tr.foldMapDefault
instance Traversable (ViewR n) where
  traverse :: (a -> f b) -> ViewR n a -> f (ViewR n b)
traverse a -> f b
f (LSeq n a
xs :> a
x) = LSeq n b -> b -> ViewR n b
forall (n :: Nat) a. LSeq n a -> a -> ViewR (1 + n) a
(:>) (LSeq n b -> b -> ViewR n b) -> f (LSeq n b) -> f (b -> ViewR n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> LSeq n a -> f (LSeq n b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f LSeq n a
xs f (b -> ViewR n b) -> f b -> f (ViewR n b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
x
instance Eq a => Eq (ViewR n a) where
  ViewR n a
s == :: ViewR n a -> ViewR n a -> Bool
== ViewR n a
s' = ViewR n a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList ViewR n a
s [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== ViewR n a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList ViewR n a
s'
instance Ord a => Ord (ViewR n a) where
  ViewR n a
s compare :: ViewR n a -> ViewR n a -> Ordering
`compare` ViewR n a
s' = ViewR n a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList ViewR n a
s [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ViewR n a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList ViewR n a
s'

-- | \( O(1) \). Analyse the right end of a sequence.
viewr    :: LSeq (1 + n) a -> ViewR (1 + n) a
viewr :: LSeq (1 + n) a -> ViewR (1 + n) a
viewr LSeq (1 + n) a
xs = let ~(Seq a
ys S.:> a
x) = Seq a -> ViewR a
forall a. Seq a -> ViewR a
S.viewr (Seq a -> ViewR a) -> Seq a -> ViewR a
forall a b. (a -> b) -> a -> b
$ LSeq (1 + n) a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq LSeq (1 + n) a
xs in Seq a -> LSeq n a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq Seq a
ys LSeq n a -> a -> ViewR (1 + n) a
forall (n :: Nat) a. LSeq n a -> a -> ViewR (1 + n) a
:> a
x

viewr'    :: LSeq (1 + n) a -> (LSeq n a, a)
viewr' :: LSeq (1 + n) a -> (LSeq n a, a)
viewr' LSeq (1 + n) a
xs = let ~(Seq a
ys S.:> a
x) = Seq a -> ViewR a
forall a. Seq a -> ViewR a
S.viewr (Seq a -> ViewR a) -> Seq a -> ViewR a
forall a b. (a -> b) -> a -> b
$ LSeq (1 + n) a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq LSeq (1 + n) a
xs in (Seq a -> LSeq n a
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq Seq a
ys, a
x)

infixl 5 :|>

-- | A bidirectional pattern synonym viewing the rear of a non-empty
-- sequence.
pattern (:|>)    :: forall n a. LSeq n a -> a -> LSeq (1 + n) a
pattern xs $b:|> :: LSeq n a -> a -> LSeq (1 + n) a
$m:|> :: forall r (n :: Nat) a.
LSeq (1 + n) a -> (LSeq n a -> a -> r) -> (Void# -> r) -> r
:|> x <- (viewr' -> (xs,x))
  where
    LSeq n a
xs :|> a
x = LSeq n a
xs LSeq n a -> a -> LSeq (1 + n) a
forall (n :: Nat) a. LSeq n a -> a -> LSeq (1 + n) a
|> a
x
{-# COMPLETE (:|>) #-}

--------------------------------------------------------------------------------

-- | Gets the first element of the LSeq
--
-- >>> head $ forceLSeq (Proxy :: Proxy 3) $ fromList [1,2,3]
-- 1
head           :: LSeq (1 + n) a -> a
head :: LSeq (1 + n) a -> a
head (x :<| _) = a
x

-- | Get the LSeq without its first element
-- -- >>> head $ forceLSeq (Proxy :: Proxy 3) $ fromList [1,2,3]
-- LSeq (fromList [2,3])
tail           :: LSeq (1 + n) a -> LSeq n a
tail :: LSeq (1 + n) a -> LSeq n a
tail (_ :<| s) = LSeq n a
s

-- s = let (x :< _) = viewl s in x

-- | Get the last element of the LSeq
--
-- >>> last $ forceLSeq (Proxy :: Proxy 3) $ fromList [1,2,3]
-- 3
last           :: LSeq (1 + n) a -> a
last :: LSeq (1 + n) a -> a
last (_ :|> x) = a
x


-- | The sequence without its last element
--
-- >>> init $ forceLSeq (Proxy :: Proxy 3) $ fromList [1,2,3]
-- LSeq (fromList [1,2])
init           :: LSeq (1 + n) a -> LSeq n a
init :: LSeq (1 + n) a -> LSeq n a
init (s :|> _) = LSeq n a
s

-- testL = (eval (Proxy :: Proxy 2) $ fromList [1..5])

-- testL' :: LSeq 2 Integer
-- testL' = fromJust testL

-- test            :: Show a => LSeq (1 + n) a -> String
-- test (x :<| xs) = show x ++ show xs


--------------------------------------------------------------------------------

-- | Zips two equal length LSeqs
zipWith         :: (a -> b -> c) -> LSeq n a -> LSeq n b -> LSeq n c
zipWith :: (a -> b -> c) -> LSeq n a -> LSeq n b -> LSeq n c
zipWith a -> b -> c
f LSeq n a
sa LSeq n b
sb = Seq c -> LSeq n c
forall (n :: Nat) a. Seq a -> LSeq n a
LSeq (Seq c -> LSeq n c) -> Seq c -> LSeq n c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c) -> Seq a -> Seq b -> Seq c
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith a -> b -> c
f (LSeq n a -> Seq a
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq LSeq n a
sa) (LSeq n b -> Seq b
forall (n :: Nat) a. LSeq n a -> Seq a
toSeq LSeq n b
sb)