{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances, GADTs,TypeSynonymInstances,FlexibleInstances,Rank2Types #-}
{-# LANGUAGE StandaloneDeriving #-}
module Data.SequenceClass(Sequence(..), ViewL(..), ViewR(..)) where
import Data.Monoid
import Data.Foldable (foldl')
import qualified Data.Foldable as F
import qualified Data.Sequence as S
infixr 5 <|
infixl 5 |>
infix 5 ><
infixl 9 :<
infixr 9 :>
class (F.Foldable s, Functor s) => Sequence s where
{-# MINIMAL
empty,
singleton,
(viewl | viewr),
((><) | (|>) | (<|))
#-}
empty :: s c
singleton :: c -> s c
(><) :: s c -> s c -> s c
viewl :: s c -> ViewL s c
viewr :: s c -> ViewR s c
(|>) :: s c -> c -> s c
(<|) :: c -> s c -> s c
fromList :: [c] -> s c
s c
l |> c
r = s c
l s c -> s c -> s c
forall (s :: * -> *) c. Sequence s => s c -> s c -> s c
>< c -> s c
forall (s :: * -> *) c. Sequence s => c -> s c
singleton c
r
c
l <| s c
r = c -> s c
forall (s :: * -> *) c. Sequence s => c -> s c
singleton c
l s c -> s c -> s c
forall (s :: * -> *) c. Sequence s => s c -> s c -> s c
>< s c
r
s c
l >< s c
r = case s c -> ViewL s c
forall (s :: * -> *) c. Sequence s => s c -> ViewL s c
viewl s c
l of
ViewL s c
EmptyL -> s c
r
c
h :< s c
t -> c
h c -> s c -> s c
forall (s :: * -> *) c. Sequence s => c -> s c -> s c
<| (s c
t s c -> s c -> s c
forall (s :: * -> *) c. Sequence s => s c -> s c -> s c
>< s c
r)
viewl s c
q = case s c -> ViewR s c
forall (s :: * -> *) c. Sequence s => s c -> ViewR s c
viewr s c
q of
ViewR s c
EmptyR -> ViewL s c
forall (s :: * -> *) c. ViewL s c
EmptyL
s c
p :> c
l -> case s c -> ViewL s c
forall (s :: * -> *) c. Sequence s => s c -> ViewL s c
viewl s c
p of
ViewL s c
EmptyL -> c
l c -> s c -> ViewL s c
forall c (s :: * -> *). c -> s c -> ViewL s c
:< s c
forall (s :: * -> *) c. Sequence s => s c
empty
c
h :< s c
t -> c
h c -> s c -> ViewL s c
forall c (s :: * -> *). c -> s c -> ViewL s c
:< (s c
t s c -> c -> s c
forall (s :: * -> *) c. Sequence s => s c -> c -> s c
|> c
l)
viewr s c
q = case s c -> ViewL s c
forall (s :: * -> *) c. Sequence s => s c -> ViewL s c
viewl s c
q of
ViewL s c
EmptyL -> ViewR s c
forall (s :: * -> *) c. ViewR s c
EmptyR
c
h :< s c
t -> case s c -> ViewR s c
forall (s :: * -> *) c. Sequence s => s c -> ViewR s c
viewr s c
t of
ViewR s c
EmptyR -> s c
forall (s :: * -> *) c. Sequence s => s c
empty s c -> c -> ViewR s c
forall (s :: * -> *) c. s c -> c -> ViewR s c
:> c
h
s c
p :> c
l -> (c
h c -> s c -> s c
forall (s :: * -> *) c. Sequence s => c -> s c -> s c
<| s c
p) s c -> c -> ViewR s c
forall (s :: * -> *) c. s c -> c -> ViewR s c
:> c
l
fromList = (s c -> c -> s c) -> s c -> [c] -> s c
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' s c -> c -> s c
forall (s :: * -> *) c. Sequence s => s c -> c -> s c
(|>) s c
forall (s :: * -> *) c. Sequence s => s c
empty
data ViewL s c where
EmptyL :: ViewL s c
(:<) :: c -> s c -> ViewL s c
deriving instance (Show c, Show (s c)) => Show (ViewL s c)
data ViewR s c where
EmptyR :: ViewR s c
(:>) :: s c -> c -> ViewR s c
deriving instance (Show c, Show (s c)) => Show (ViewR s c)
instance Sequence S.Seq where
empty :: Seq c
empty = Seq c
forall c. Seq c
S.empty
singleton :: c -> Seq c
singleton = c -> Seq c
forall c. c -> Seq c
S.singleton
<| :: c -> Seq c -> Seq c
(<|) = c -> Seq c -> Seq c
forall c. c -> Seq c -> Seq c
(S.<|)
|> :: Seq c -> c -> Seq c
(|>) = Seq c -> c -> Seq c
forall c. Seq c -> c -> Seq c
(S.|>)
>< :: Seq c -> Seq c -> Seq c
(><) = Seq c -> Seq c -> Seq c
forall c. Seq c -> Seq c -> Seq c
(S.><)
viewl :: Seq c -> ViewL Seq c
viewl Seq c
s = case Seq c -> ViewL c
forall a. Seq a -> ViewL a
S.viewl Seq c
s of
ViewL c
S.EmptyL -> ViewL Seq c
forall (s :: * -> *) c. ViewL s c
EmptyL
c
h S.:< Seq c
t -> c
h c -> Seq c -> ViewL Seq c
forall c (s :: * -> *). c -> s c -> ViewL s c
:< Seq c
t
viewr :: Seq c -> ViewR Seq c
viewr Seq c
s = case Seq c -> ViewR c
forall a. Seq a -> ViewR a
S.viewr Seq c
s of
ViewR c
S.EmptyR -> ViewR Seq c
forall (s :: * -> *) c. ViewR s c
EmptyR
Seq c
t S.:> c
h -> Seq c
t Seq c -> c -> ViewR Seq c
forall (s :: * -> *) c. s c -> c -> ViewR s c
:> c
h
fromList :: [c] -> Seq c
fromList = [c] -> Seq c
forall c. [c] -> Seq c
S.fromList
instance Sequence [] where
empty :: [c]
empty = []
singleton :: c -> [c]
singleton c
x = [c
x]
<| :: c -> [c] -> [c]
(<|) = (:)
[c]
xs |> :: [c] -> c -> [c]
|> c
x = [c]
xs [c] -> [c] -> [c]
forall c. [c] -> [c] -> [c]
++ [c
x]
>< :: [c] -> [c] -> [c]
(><) = [c] -> [c] -> [c]
forall c. [c] -> [c] -> [c]
(++)
viewl :: [c] -> ViewL [] c
viewl [] = ViewL [] c
forall (s :: * -> *) c. ViewL s c
EmptyL
viewl (c
h : [c]
t) = c
h c -> [c] -> ViewL [] c
forall c (s :: * -> *). c -> s c -> ViewL s c
:< [c]
t
viewr :: [c] -> ViewR [] c
viewr [] = ViewR [] c
forall (s :: * -> *) c. ViewR s c
EmptyR
viewr (c
x : [c]
xs) = case c -> [c] -> ([c], c)
forall t. t -> [t] -> ([t], t)
go c
x [c]
xs of ([c]
start, c
end) -> [c]
start [c] -> c -> ViewR [] c
forall (s :: * -> *) c. s c -> c -> ViewR s c
:> c
end
where
go :: t -> [t] -> ([t], t)
go t
y [] = ([], t
y)
go t
y (t
z : [t]
zs) = case t -> [t] -> ([t], t)
go t
z [t]
zs of ([t]
start, t
end) -> (t
y t -> [t] -> [t]
forall c. c -> [c] -> [c]
: [t]
start, t
end)
fromList :: [c] -> [c]
fromList = [c] -> [c]
forall a. a -> a
id