{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
#endif
module Data.Sequence.ToCatQueue.Internal
( ToCatQueue (..)
) where
import Control.Applicative hiding (empty)
import Data.Foldable
import Data.Traversable
import Data.Monoid (Monoid (..))
import qualified Text.Read as TR
#if MIN_VERSION_base(4,9,0)
import qualified Data.Semigroup as Semigroup
import Data.Functor.Classes (Show1 (..))
#endif
import Data.Function (on)
import Prelude hiding (foldr,foldl)
import Data.SequenceClass
data ToCatQueue q a where
C0 :: ToCatQueue q a
CN :: a -> !(q (ToCatQueue q a)) -> ToCatQueue q a
deriving instance Functor q => Functor (ToCatQueue q)
deriving instance Foldable q => Foldable (ToCatQueue q)
deriving instance Traversable q => Traversable (ToCatQueue q)
instance (Show a, Foldable q) => Show (ToCatQueue q a) where
showsPrec :: Int -> ToCatQueue q a -> ShowS
showsPrec Int
p ToCatQueue q a
xs = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
forall a. Show a => a -> ShowS
shows (ToCatQueue q a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ToCatQueue q a
xs)
#if MIN_VERSION_base(4,9,0)
instance Foldable q => Show1 (ToCatQueue q) where
liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ToCatQueue q a -> ShowS
liftShowsPrec Int -> a -> ShowS
_shwsPrc [a] -> ShowS
shwList Int
p ToCatQueue q a
xs = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
shwList (ToCatQueue q a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ToCatQueue q a
xs)
#endif
instance (Sequence q, Read a) => Read (ToCatQueue q a) where
readPrec :: ReadPrec (ToCatQueue q a)
readPrec = ReadPrec (ToCatQueue q a) -> ReadPrec (ToCatQueue q a)
forall a. ReadPrec a -> ReadPrec a
TR.parens (ReadPrec (ToCatQueue q a) -> ReadPrec (ToCatQueue q a))
-> ReadPrec (ToCatQueue q a) -> ReadPrec (ToCatQueue q a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (ToCatQueue q a) -> ReadPrec (ToCatQueue q a)
forall a. Int -> ReadPrec a -> ReadPrec a
TR.prec Int
10 (ReadPrec (ToCatQueue q a) -> ReadPrec (ToCatQueue q a))
-> ReadPrec (ToCatQueue q a) -> ReadPrec (ToCatQueue q a)
forall a b. (a -> b) -> a -> b
$ do
TR.Ident String
"fromList" <- ReadPrec Lexeme
TR.lexP
[a]
xs <- ReadPrec [a]
forall a. Read a => ReadPrec a
TR.readPrec
ToCatQueue q a -> ReadPrec (ToCatQueue q a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> ToCatQueue q a
forall (s :: * -> *) c. Sequence s => [c] -> s c
fromList [a]
xs)
readListPrec :: ReadPrec [ToCatQueue q a]
readListPrec = ReadPrec [ToCatQueue q a]
forall a. Read a => ReadPrec [a]
TR.readListPrecDefault
instance (Foldable q, Eq a) => Eq (ToCatQueue q a) where
== :: ToCatQueue q a -> ToCatQueue q a -> Bool
(==) = [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([a] -> [a] -> Bool)
-> (ToCatQueue q a -> [a])
-> ToCatQueue q a
-> ToCatQueue q a
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ToCatQueue q a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance (Foldable q, Ord a) => Ord (ToCatQueue q a) where
compare :: ToCatQueue q a -> ToCatQueue q a -> Ordering
compare = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([a] -> [a] -> Ordering)
-> (ToCatQueue q a -> [a])
-> ToCatQueue q a
-> ToCatQueue q a
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ToCatQueue q a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance Sequence q => Sequence (ToCatQueue q) where
empty :: ToCatQueue q c
empty = ToCatQueue q c
forall (q :: * -> *) a. ToCatQueue q a
C0
singleton :: c -> ToCatQueue q c
singleton c
a = c -> q (ToCatQueue q c) -> ToCatQueue q c
forall a (q :: * -> *). a -> q (ToCatQueue q a) -> ToCatQueue q a
CN c
a q (ToCatQueue q c)
forall (s :: * -> *) c. Sequence s => s c
empty
ToCatQueue q c
C0 >< :: ToCatQueue q c -> ToCatQueue q c -> ToCatQueue q c
>< ToCatQueue q c
ys = ToCatQueue q c
ys
ToCatQueue q c
xs >< ToCatQueue q c
C0 = ToCatQueue q c
xs
(CN c
x q (ToCatQueue q c)
q) >< ToCatQueue q c
ys = c -> q (ToCatQueue q c) -> ToCatQueue q c
forall a (q :: * -> *). a -> q (ToCatQueue q a) -> ToCatQueue q a
CN c
x (q (ToCatQueue q c)
q q (ToCatQueue q c) -> ToCatQueue q c -> q (ToCatQueue q c)
forall (s :: * -> *) c. Sequence s => s c -> c -> s c
|> ToCatQueue q c
ys)
viewl :: ToCatQueue q c -> ViewL (ToCatQueue q) c
viewl ToCatQueue q c
C0 = ViewL (ToCatQueue q) c
forall (s :: * -> *) c. ViewL s c
EmptyL
viewl (CN c
x0 q (ToCatQueue q c)
q0) = c
x0 c -> ToCatQueue q c -> ViewL (ToCatQueue q) c
forall c (s :: * -> *). c -> s c -> ViewL s c
:< case q (ToCatQueue q c) -> ViewL q (ToCatQueue q c)
forall (s :: * -> *) c. Sequence s => s c -> ViewL s c
viewl q (ToCatQueue q c)
q0 of
ViewL q (ToCatQueue q c)
EmptyL -> ToCatQueue q c
forall (q :: * -> *) a. ToCatQueue q a
C0
ToCatQueue q c
t :< q (ToCatQueue q c)
q' -> ToCatQueue q c -> q (ToCatQueue q c) -> ToCatQueue q c
forall a. ToCatQueue q a -> q (ToCatQueue q a) -> ToCatQueue q a
linkAll ToCatQueue q c
t q (ToCatQueue q c)
q'
where
linkAll :: ToCatQueue q a -> q (ToCatQueue q a) -> ToCatQueue q a
linkAll :: ToCatQueue q a -> q (ToCatQueue q a) -> ToCatQueue q a
linkAll t :: ToCatQueue q a
t@(CN a
x q (ToCatQueue q a)
q) q (ToCatQueue q a)
q' = case q (ToCatQueue q a) -> ViewL q (ToCatQueue q a)
forall (s :: * -> *) c. Sequence s => s c -> ViewL s c
viewl q (ToCatQueue q a)
q' of
ViewL q (ToCatQueue q a)
EmptyL -> ToCatQueue q a
t
ToCatQueue q a
h :< q (ToCatQueue q a)
t' -> a -> q (ToCatQueue q a) -> ToCatQueue q a
forall a (q :: * -> *). a -> q (ToCatQueue q a) -> ToCatQueue q a
CN a
x (q (ToCatQueue q a)
q q (ToCatQueue q a) -> ToCatQueue q a -> q (ToCatQueue q a)
forall (s :: * -> *) c. Sequence s => s c -> c -> s c
|> ToCatQueue q a -> q (ToCatQueue q a) -> ToCatQueue q a
forall a. ToCatQueue q a -> q (ToCatQueue q a) -> ToCatQueue q a
linkAll ToCatQueue q a
h q (ToCatQueue q a)
t')
linkAll ToCatQueue q a
C0 q (ToCatQueue q a)
_ = String -> ToCatQueue q a
forall a. HasCallStack => String -> a
error String
"Invariant failure"
viewr :: ToCatQueue q c -> ViewR (ToCatQueue q) c
viewr = (ViewR (ToCatQueue q) c -> c -> ViewR (ToCatQueue q) c)
-> ViewR (ToCatQueue q) c
-> ToCatQueue q c
-> ViewR (ToCatQueue q) c
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ViewR (ToCatQueue q) c -> c -> ViewR (ToCatQueue q) c
forall (s :: * -> *) c. Sequence s => ViewR s c -> c -> ViewR s c
go ViewR (ToCatQueue q) c
forall (s :: * -> *) c. ViewR s c
EmptyR
where
go :: ViewR s c -> c -> ViewR s c
go ViewR s c
EmptyR c
y = 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
y
go (s c
xs :> c
x) c
y = s c
xs' s c -> c -> ViewR s c
forall (s :: * -> *) c. s c -> c -> ViewR s c
:> c
y
where
!xs' :: s c
xs' = s c
xs s c -> c -> s c
forall (s :: * -> *) c. Sequence s => s c -> c -> s c
|> c
x
#if MIN_VERSION_base(4,9,0)
instance Sequence q => Semigroup.Semigroup (ToCatQueue q a) where
<> :: ToCatQueue q a -> ToCatQueue q a -> ToCatQueue q a
(<>) = ToCatQueue q a -> ToCatQueue q a -> ToCatQueue q a
forall (s :: * -> *) c. Sequence s => s c -> s c -> s c
(><)
#endif
instance Sequence q => Monoid (ToCatQueue q a) where
mempty :: ToCatQueue q a
mempty = ToCatQueue q a
forall (s :: * -> *) c. Sequence s => s c
empty
#if MIN_VERSION_base(4,9,0)
mappend :: ToCatQueue q a -> ToCatQueue q a -> ToCatQueue q a
mappend = ToCatQueue q a -> ToCatQueue q a -> ToCatQueue q a
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)
#else
mappend = (><)
#endif