module Data.CircularSeq( CSeq
, cseq
, singleton
, fromNonEmpty
, fromList
, focus
, index, adjust
, item
, rotateL
, rotateR
, rotateNL, rotateNR
, rightElements
, leftElements
, asSeq
, reverseDirection
, allRotations
, findRotateTo
, rotateTo
) where
import Control.Applicative
import Control.Lens(lens, Lens')
import qualified Data.Foldable as F
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe (listToMaybe)
import Data.Semigroup
import Data.Semigroup.Foldable
import Data.Sequence ((|>),(<|),ViewL(..),ViewR(..),Seq)
import qualified Data.Sequence as S
import qualified Data.Traversable as T
import Data.Tuple (swap)
data CSeq a = CSeq !(Seq a) !a !(Seq a)
deriving (Eq)
instance Show a => Show (CSeq a) where
showsPrec d s = showParen (d > app_prec) $
showString (("CSeq " <>) . show . F.toList . rightElements $ s)
where app_prec = 10
instance T.Traversable CSeq where
traverse f (CSeq l x r) = (\x' r' l' -> CSeq l' x' r')
<$> f x <*> traverse f r <*> traverse f l
instance Foldable1 CSeq
instance F.Foldable CSeq where
foldMap = T.foldMapDefault
length (CSeq l _ r) = 1 + S.length l + S.length r
instance Functor CSeq where
fmap = T.fmapDefault
singleton :: a -> CSeq a
singleton x = CSeq S.empty x S.empty
focus :: CSeq a -> a
focus (CSeq _ x _) = x
index :: CSeq a -> Int -> a
index s@(CSeq l x r) i' = let i = i' `mod` length s
rn = length r
in if i == 0 then x
else if i 1 < rn then S.index r (i 1)
else S.index l (i rn 1)
adjust :: (a -> a) -> Int -> CSeq a -> CSeq a
adjust f i' s@(CSeq l x r) = let i = i' `mod` length s
rn = length r
in if i == 0 then CSeq l (f x) r
else if i 1 < rn
then CSeq l x (S.adjust f (i 1) r)
else CSeq (S.adjust f (i rn 1) l) x r
item :: Int -> Lens' (CSeq a) a
item i = lens (flip index i) (\s x -> adjust (const x) i s)
resplit :: Seq a -> (Seq a, Seq a)
resplit s = swap $ S.splitAt (length s `div` 2) s
cseq :: Seq a -> a -> Seq a -> CSeq a
cseq l x r
| ln > 1 + 2*rn = withFocus x (r <> l)
| ln < rn `div` 2 = withFocus x (r <> l)
| otherwise = CSeq l x r
where
rn = length r
ln = length l
withFocus :: a -> Seq a -> CSeq a
withFocus x s = let (l,r) = resplit s in CSeq l x r
rotateR :: CSeq a -> CSeq a
rotateR s@(CSeq l x r) = case S.viewl r of
EmptyL -> case S.viewl l of
EmptyL -> s
(y :< l') -> cseq (S.singleton x) y l'
(y :< r') -> cseq (l |> x) y r'
rotateL :: CSeq a -> CSeq a
rotateL s@(CSeq l x r) = case S.viewr l of
EmptyR -> case S.viewr r of
EmptyR -> s
(r' :> y) -> cseq r' y (S.singleton x)
(l' :> y) -> cseq l' y (x <| r)
asSeq :: CSeq a -> Seq a
asSeq = rightElements
rightElements :: CSeq a -> Seq a
rightElements (CSeq l x r) = x <| r <> l
leftElements :: CSeq a -> Seq a
leftElements (CSeq l x r) = x <| S.reverse l <> S.reverse r
fromNonEmpty :: NonEmpty.NonEmpty a -> CSeq a
fromNonEmpty (x NonEmpty.:| xs) = withFocus x $ S.fromList xs
fromList :: [a] -> CSeq a
fromList (x:xs) = withFocus x $ S.fromList xs
fromList [] = error "fromList: Empty list"
rotateNR :: Int -> CSeq a -> CSeq a
rotateNR i s = let (l, r') = S.splitAt i $ rightElements s
(x :< r) = S.viewl r'
in cseq l x r
rotateNL :: Int -> CSeq a -> CSeq a
rotateNL i s = let (x :< xs) = S.viewl $ rightElements s
(l',r) = S.splitAt (length s i) $ xs |> x
(l :> y) = S.viewr l'
in cseq l y r
reverseDirection :: CSeq a -> CSeq a
reverseDirection (CSeq l x r) = CSeq (S.reverse r) x (S.reverse l)
findRotateTo :: (a -> Bool) -> CSeq a -> Maybe (CSeq a)
findRotateTo p = listToMaybe . filter (p . focus) . allRotations'
rotateTo :: Eq a => a -> CSeq a -> Maybe (CSeq a)
rotateTo x = findRotateTo (== x)
allRotations :: CSeq a -> CSeq (CSeq a)
allRotations = fromList . allRotations'
allRotations' :: CSeq a -> [CSeq a]
allRotations' s = take (length s) . iterate rotateR $ s