module Data.CircularList.Internal where
import Control.Applicative hiding (empty)
import Prelude
import Data.List(find,unfoldr,foldl')
import Control.DeepSeq(NFData(..))
import Control.Monad(join)
import qualified Data.Traversable as T
import qualified Data.Foldable as F
data CList a = Empty
| CList [a] a [a]
empty :: CList a
empty :: forall a. CList a
empty = forall a. CList a
Empty
fromList :: [a] -> CList a
fromList :: forall a. [a] -> CList a
fromList [] = forall a. CList a
Empty
fromList a :: [a]
a@(a
i:[a]
is) = let len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
a
([a]
r,[a]
l) = forall a. Int -> [a] -> ([a], [a])
splitAt (Int
len forall a. Integral a => a -> a -> a
`div` Int
2) [a]
is
in forall a. [a] -> a -> [a] -> CList a
CList (forall a. [a] -> [a]
reverse [a]
l) a
i [a]
r
singleton :: a -> CList a
singleton :: forall a. a -> CList a
singleton a
a = forall a. [a] -> a -> [a] -> CList a
CList [] a
a []
update :: a -> CList a -> CList a
update :: forall a. a -> CList a -> CList a
update a
v CList a
Empty = forall a. [a] -> a -> [a] -> CList a
CList [] a
v []
update a
v (CList [a]
l a
_ [a]
r) = forall a. [a] -> a -> [a] -> CList a
CList [a]
l a
v [a]
r
reverseDirection :: CList a -> CList a
reverseDirection :: forall a. CList a -> CList a
reverseDirection CList a
Empty = forall a. CList a
Empty
reverseDirection (CList [a]
l a
f [a]
r) = forall a. [a] -> a -> [a] -> CList a
CList [a]
r a
f [a]
l
leftElements :: CList a -> [a]
leftElements :: forall a. CList a -> [a]
leftElements CList a
Empty = []
leftElements (CList [a]
l a
f [a]
r) = a
f forall a. a -> [a] -> [a]
: ([a]
l forall a. [a] -> [a] -> [a]
++ (forall a. [a] -> [a]
reverse [a]
r))
rightElements :: CList a -> [a]
rightElements :: forall a. CList a -> [a]
rightElements CList a
Empty = []
rightElements (CList [a]
l a
f [a]
r) = a
f forall a. a -> [a] -> [a]
: ([a]
r forall a. [a] -> [a] -> [a]
++ (forall a. [a] -> [a]
reverse [a]
l))
toList :: CList a -> [a]
toList :: forall a. CList a -> [a]
toList = forall a. CList a -> [a]
rightElements
toInfList :: CList a -> [a]
toInfList :: forall a. CList a -> [a]
toInfList = forall a. [a] -> [a]
cycle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CList a -> [a]
toList
focus :: CList a -> Maybe a
focus :: forall a. CList a -> Maybe a
focus CList a
Empty = forall a. Maybe a
Nothing
focus (CList [a]
_ a
f [a]
_) = forall a. a -> Maybe a
Just a
f
insertR :: a -> CList a -> CList a
insertR :: forall a. a -> CList a -> CList a
insertR a
i CList a
Empty = forall a. [a] -> a -> [a] -> CList a
CList [] a
i []
insertR a
i (CList [a]
l a
f [a]
r) = forall a. [a] -> a -> [a] -> CList a
CList [a]
l a
i (a
fforall a. a -> [a] -> [a]
:[a]
r)
insertL :: a -> CList a -> CList a
insertL :: forall a. a -> CList a -> CList a
insertL a
i CList a
Empty = forall a. [a] -> a -> [a] -> CList a
CList [] a
i []
insertL a
i (CList [a]
l a
f [a]
r) = forall a. [a] -> a -> [a] -> CList a
CList (a
fforall a. a -> [a] -> [a]
:[a]
l) a
i [a]
r
removeL :: CList a -> CList a
removeL :: forall a. CList a -> CList a
removeL CList a
Empty = forall a. CList a
Empty
removeL (CList [] a
_ []) = forall a. CList a
Empty
removeL (CList (a
l:[a]
ls) a
_ [a]
rs) = forall a. [a] -> a -> [a] -> CList a
CList [a]
ls a
l [a]
rs
removeL (CList [] a
_ [a]
rs) = let (a
f:[a]
ls) = forall a. [a] -> [a]
reverse [a]
rs
in forall a. [a] -> a -> [a] -> CList a
CList [a]
ls a
f []
removeR :: CList a -> CList a
removeR :: forall a. CList a -> CList a
removeR CList a
Empty = forall a. CList a
Empty
removeR (CList [] a
_ []) = forall a. CList a
Empty
removeR (CList [a]
l a
_ (a
r:[a]
rs)) = forall a. [a] -> a -> [a] -> CList a
CList [a]
l a
r [a]
rs
removeR (CList [a]
l a
_ []) = let (a
f:[a]
rs) = forall a. [a] -> [a]
reverse [a]
l
in forall a. [a] -> a -> [a] -> CList a
CList [] a
f [a]
rs
allRotations :: CList a -> CList (CList a)
allRotations :: forall a. CList a -> CList (CList a)
allRotations CList a
Empty = forall a. a -> CList a
singleton forall a. CList a
Empty
allRotations CList a
cl = forall a. [a] -> a -> [a] -> CList a
CList [CList a]
ls CList a
cl [CList a]
rs
where
ls :: [CList a]
ls = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (,)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CList a -> Maybe (CList a)
mRotL) CList a
cl
rs :: [CList a]
rs = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (,)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CList a -> Maybe (CList a)
mRotR) CList a
cl
rotL :: CList a -> CList a
rotL :: forall a. CList a -> CList a
rotL CList a
Empty = forall a. CList a
Empty
rotL r :: CList a
r@(CList [] a
_ []) = CList a
r
rotL (CList (a
l:[a]
ls) a
f [a]
rs) = forall a. [a] -> a -> [a] -> CList a
CList [a]
ls a
l (a
fforall a. a -> [a] -> [a]
:[a]
rs)
rotL (CList [] a
f [a]
rs) = let (a
l:[a]
ls) = forall a. [a] -> [a]
reverse [a]
rs
in forall a. [a] -> a -> [a] -> CList a
CList [a]
ls a
l [a
f]
mRotL :: CList a -> Maybe (CList a)
mRotL :: forall a. CList a -> Maybe (CList a)
mRotL (CList (a
l:[a]
ls) a
f [a]
rs) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a -> [a] -> CList a
CList [a]
ls a
l (a
fforall a. a -> [a] -> [a]
:[a]
rs)
mRotL CList a
_ = forall a. Maybe a
Nothing
rotR :: CList a -> CList a
rotR :: forall a. CList a -> CList a
rotR CList a
Empty = forall a. CList a
Empty
rotR r :: CList a
r@(CList [] a
_ []) = CList a
r
rotR (CList [a]
ls a
f (a
r:[a]
rs)) = forall a. [a] -> a -> [a] -> CList a
CList (a
fforall a. a -> [a] -> [a]
:[a]
ls) a
r [a]
rs
rotR (CList [a]
ls a
f []) = let (a
r:[a]
rs) = forall a. [a] -> [a]
reverse [a]
ls
in forall a. [a] -> a -> [a] -> CList a
CList [a
f] a
r [a]
rs
mRotR :: CList a -> Maybe (CList a)
mRotR :: forall a. CList a -> Maybe (CList a)
mRotR (CList [a]
ls a
f (a
r:[a]
rs)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a -> [a] -> CList a
CList (a
fforall a. a -> [a] -> [a]
:[a]
ls) a
r [a]
rs
mRotR CList a
_ = forall a. Maybe a
Nothing
rotN :: Int -> CList a -> CList a
rotN :: forall a. Int -> CList a -> CList a
rotN Int
_ CList a
Empty = forall a. CList a
Empty
rotN Int
_ cl :: CList a
cl@(CList [] a
_ []) = CList a
cl
rotN Int
n CList a
cl = forall a. (a -> a) -> a -> [a]
iterate forall a. CList a -> CList a
rot CList a
cl forall a. [a] -> Int -> a
!! Int
n'
where
n' :: Int
n' = forall a. Num a => a -> a
abs Int
n
rot :: CList a -> CList a
rot | Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. CList a -> CList a
rotL
| Bool
otherwise = forall a. CList a -> CList a
rotR
rotNR :: Int -> CList a -> CList a
rotNR :: forall a. Int -> CList a -> CList a
rotNR Int
n CList a
cl
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = CList a
cl
| Bool
otherwise = forall a. Int -> CList a -> CList a
rotN Int
n CList a
cl
rotNL :: Int -> CList a -> CList a
rotNL :: forall a. Int -> CList a -> CList a
rotNL Int
n CList a
cl
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = CList a
cl
| Bool
otherwise = forall a. Int -> CList a -> CList a
rotN (forall a. Num a => a -> a
negate Int
n) CList a
cl
rotateTo :: (Eq a) => a -> CList a -> Maybe (CList a)
rotateTo :: forall a. Eq a => a -> CList a -> Maybe (CList a)
rotateTo a
a = forall a. (a -> Bool) -> CList a -> Maybe (CList a)
findRotateTo (a
aforall a. Eq a => a -> a -> Bool
==)
findRotateTo :: (a -> Bool) -> CList a -> Maybe (CList a)
findRotateTo :: forall a. (a -> Bool) -> CList a -> Maybe (CList a)
findRotateTo a -> Bool
p = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False a -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CList a -> Maybe a
focus) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CList a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CList a -> CList (CList a)
allRotations
filterR :: (a -> Bool) -> CList a -> CList a
filterR :: forall a. (a -> Bool) -> CList a -> CList a
filterR = forall a. (CList a -> CList a) -> (a -> Bool) -> CList a -> CList a
filterCL forall a. CList a -> CList a
removeR
filterL :: (a -> Bool) -> CList a -> CList a
filterL :: forall a. (a -> Bool) -> CList a -> CList a
filterL = forall a. (CList a -> CList a) -> (a -> Bool) -> CList a -> CList a
filterCL forall a. CList a -> CList a
removeL
filterCL :: (CList a -> CList a) -> (a -> Bool) -> CList a -> CList a
filterCL :: forall a. (CList a -> CList a) -> (a -> Bool) -> CList a -> CList a
filterCL CList a -> CList a
_ a -> Bool
_ CList a
Empty = forall a. CList a
Empty
filterCL CList a -> CList a
rm a -> Bool
p (CList [a]
l a
f [a]
r)
| a -> Bool
p a
f = CList a
cl'
| Bool
otherwise = CList a -> CList a
rm CList a
cl'
where
cl' :: CList a
cl' = forall a. [a] -> a -> [a] -> CList a
CList (forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p [a]
l) a
f (forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p [a]
r)
foldrR :: (a -> b -> b) -> b -> CList a -> b
foldrR :: forall a b. (a -> b -> b) -> b -> CList a -> b
foldrR = forall a b. (CList a -> [a]) -> (a -> b -> b) -> b -> CList a -> b
foldrCL forall a. CList a -> [a]
rightElements
foldrL :: (a -> b -> b) -> b -> CList a -> b
foldrL :: forall a b. (a -> b -> b) -> b -> CList a -> b
foldrL = forall a b. (CList a -> [a]) -> (a -> b -> b) -> b -> CList a -> b
foldrCL forall a. CList a -> [a]
leftElements
foldrCL :: (CList a -> [a]) -> (a -> b -> b) -> b -> CList a -> b
foldrCL :: forall a b. (CList a -> [a]) -> (a -> b -> b) -> b -> CList a -> b
foldrCL CList a -> [a]
toL a -> b -> b
f b
a = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. CList a -> [a]
toL
foldlR :: (a -> b -> a) -> a -> CList b -> a
foldlR :: forall a b. (a -> b -> a) -> a -> CList b -> a
foldlR = forall b a. (CList b -> [b]) -> (a -> b -> a) -> a -> CList b -> a
foldlCL forall a. CList a -> [a]
rightElements
foldlL :: (a -> b -> a) -> a -> CList b -> a
foldlL :: forall a b. (a -> b -> a) -> a -> CList b -> a
foldlL = forall b a. (CList b -> [b]) -> (a -> b -> a) -> a -> CList b -> a
foldlCL forall a. CList a -> [a]
leftElements
foldlCL :: (CList b -> [b]) -> (a -> b -> a) -> a -> CList b -> a
foldlCL :: forall b a. (CList b -> [b]) -> (a -> b -> a) -> a -> CList b -> a
foldlCL CList b -> [b]
toL a -> b -> a
f a
a = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> b -> a
f a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. CList b -> [b]
toL
balance :: CList a -> CList a
balance :: forall a. CList a -> CList a
balance = forall a. [a] -> CList a
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CList a -> [a]
toList
packL :: CList a -> CList a
packL :: forall a. CList a -> CList a
packL CList a
Empty = forall a. CList a
Empty
packL (CList [a]
l a
f [a]
r) = forall a. [a] -> a -> [a] -> CList a
CList ([a]
l forall a. [a] -> [a] -> [a]
++ (forall a. [a] -> [a]
reverse [a]
r)) a
f []
packR :: CList a -> CList a
packR :: forall a. CList a -> CList a
packR CList a
Empty = forall a. CList a
Empty
packR (CList [a]
l a
f [a]
r) = forall a. [a] -> a -> [a] -> CList a
CList [] a
f ([a]
r forall a. [a] -> [a] -> [a]
++ (forall a. [a] -> [a]
reverse [a]
l))
isEmpty :: CList a -> Bool
isEmpty :: forall a. CList a -> Bool
isEmpty CList a
Empty = Bool
True
isEmpty CList a
_ = Bool
False
size :: CList a -> Int
size :: forall a. CList a -> Int
size CList a
Empty = Int
0
size (CList [a]
l a
_ [a]
r) = Int
1 forall a. Num a => a -> a -> a
+ (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l) forall a. Num a => a -> a -> a
+ (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
r)
instance (Show a) => Show (CList a) where
showsPrec :: Int -> CList a -> ShowS
showsPrec Int
d CList a
cl = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"fromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall a. CList a -> [a]
toList CList a
cl)
instance (Read a) => Read (CList a) where
readsPrec :: Int -> ReadS (CList a)
readsPrec Int
p = forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ \ String
r -> do
(String
"fromList",String
s) <- ReadS String
lex String
r
([a]
xs,String
t) <- forall a. Read a => ReadS a
reads String
s
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> CList a
fromList [a]
xs,String
t)
instance (Eq a) => Eq (CList a) where
CList a
a == :: CList a -> CList a -> Bool
== CList a
b = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. CList a -> [a]
toList CList a
a forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CList a -> [a]
toList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CList a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. CList a -> CList (CList a)
allRotations CList a
b
instance (NFData a) => NFData (CList a) where
rnf :: CList a -> ()
rnf CList a
Empty = ()
rnf (CList [a]
l a
f [a]
r) = forall a. NFData a => a -> ()
rnf a
f
seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [a]
l
seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [a]
r
instance Functor CList where
fmap :: forall a b. (a -> b) -> CList a -> CList b
fmap a -> b
_ CList a
Empty = forall a. CList a
Empty
fmap a -> b
fn (CList [a]
l a
f [a]
r) = (forall a. [a] -> a -> [a] -> CList a
CList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
fn [a]
l) (a -> b
fn a
f) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
fn [a]
r))
instance F.Foldable CList where
foldMap :: forall m a. Monoid m => (a -> m) -> CList a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
T.foldMapDefault
instance T.Traversable CList where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CList a -> f (CList b)
traverse a -> f b
_ CList a
Empty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. CList a
Empty
traverse a -> f b
g (CList [a]
l a
f [a]
r) = (\b
f' [b]
r' [b]
l' -> forall a. [a] -> a -> [a] -> CList a
CList [b]
l' b
f' [b]
r') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
g a
f
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse a -> f b
g [a]
r
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse a -> f b
g [a]
l