module Data.Carousel
( Carousel
, empty
, cursor
, moveLeft
, moveRight
, dropCursor
, nub
, append
, clSequence
, clList
) where
import Control.Lens
import qualified Data.Foldable as F
import qualified Data.List as L
import qualified Data.Sequence as S
newtype Carousel α
= Carousel
{ _clSequence ∷ S.Seq α
} deriving (Show, Eq)
instance Functor Carousel where
fmap f (Carousel sq) = Carousel $ fmap f sq
instance F.Foldable Carousel where
foldMap f (Carousel sq) = F.foldMap f sq
instance Traversable Carousel where
traverse f (Carousel sq) = fmap Carousel (traverse f sq)
clSequence ∷ Iso (Carousel α) (Carousel β) (S.Seq α) (S.Seq β)
clSequence = iso _clSequence Carousel
clList ∷ Iso (Carousel α) (Carousel β) [α] [β]
clList = clSequence . iso F.toList S.fromList
cursor ∷ Traversal' (Carousel α) α
cursor = clSequence . _head
dropCursor
∷ Carousel α
→ Carousel α
dropCursor = clSequence %~ (^. _tail)
moveRight
∷ Carousel α
→ Carousel α
moveRight = clSequence %~ rotate . S.viewl
where
rotate
∷ S.ViewL α
→ S.Seq α
rotate S.EmptyL = S.empty
rotate (x S.:< xs) = xs S.|> x
moveLeft
∷ Carousel α
→ Carousel α
moveLeft = clSequence %~ rotate . S.viewr
where
rotate
∷ S.ViewR α
→ S.Seq α
rotate S.EmptyR = S.empty
rotate (xs S.:> x) = x S.<| xs
empty
∷ Carousel α
empty = Carousel S.empty
append
∷ [α]
→ Carousel α
→ Carousel α
append xs = clSequence %~ (S.>< S.fromList xs)
nub
∷ Eq α
⇒ Carousel α
→ Carousel α
nub = clList %~ L.nub