module Control.Comonad.Zipper.Extra (
Control.Comonad.Store.Zipper.Zipper
, Control.Comonad.Store.Zipper.zipper
, Control.Comonad.Store.Zipper.zipper1
, Control.Comonad.Store.Zipper.unzipper
, Control.Comonad.Store.Zipper.size
, paginate
, paginate'
, PaginationException(..)
, zipperNextMaybe
, zipperPreviousMaybe
, zipperWithin
, zipper'
, ZipperException(..)
, elemIndexThrow
, ElemNotFoundException(..)
, seekOn
, seekOnThrow
) where
import Control.Monad.Catch
import Control.Comonad.Store
import Control.Comonad.Store.Zipper
import Data.List
import Data.List.Split
import Data.Typeable
paginate :: Int -> [a] -> Maybe (Zipper [] [a])
paginate n = zipper . chunksOf n
data PaginationException = EmptyContentsError | ZeroPageSize | UnknownPaginationException
deriving (Show, Eq, Typeable)
instance Exception PaginationException where
displayException EmptyContentsError = "Can not create a Zipper of length zero."
displayException ZeroPageSize = "Can not divide into pages of size zero."
displayException UnknownPaginationException = "Unknown pagination exception."
paginate' :: MonadThrow m => Int -> [a] -> m (Zipper [] [a])
paginate' n xs = case paginate n xs of
Just x -> return x
Nothing -> if n == 0 then throwM ZeroPageSize
else if null xs then throwM EmptyContentsError
else throwM UnknownPaginationException
zipperNextMaybe :: Zipper t a -> Maybe a
zipperNextMaybe xs = if pos xs < size xs-1 then Just (peeks (+1) xs) else Nothing
zipperPreviousMaybe :: Zipper t a -> Maybe a
zipperPreviousMaybe xs = if pos xs > 0 then Just (peeks (+ (-1)) xs) else Nothing
zipperWithin :: Int -> Zipper t a -> [a]
zipperWithin r xs = (`peek` xs) <$> [(max 0 (pos xs - r)) .. (min (size xs -1) (pos xs + r))]
data ZipperException = EmptyZipper
deriving (Show, Eq, Typeable)
instance Exception ZipperException where
displayException EmptyZipper = "Can not create an empty zipper."
zipper' :: (MonadThrow m, Traversable t) => t a -> m (Zipper t a)
zipper' xs = maybe (throwM EmptyZipper) return $ zipper xs
data ElemNotFoundException a = ElemNotFoundException a [a]
deriving (Show, Eq, Typeable)
instance (Typeable a, Show a) => Exception (ElemNotFoundException a) where
displayException (ElemNotFoundException x xs) = "Elem " <> show x <> " not found in " <> show xs
elemIndexThrow :: (MonadThrow m, Eq a, Typeable a, Show a) => a -> [a] -> m Int
elemIndexThrow x xs = case elemIndex x xs of
Nothing -> throwM $ ElemNotFoundException x xs
Just a -> return a
seekOn :: Eq b => (a -> b) -> b -> Zipper [] a -> Maybe (Zipper [] a)
seekOn f x ys = do
k <- elemIndex x (f <$> unzipper ys)
return $ seek k ys
seekOnThrow :: (MonadThrow m, Eq b, Typeable b, Show b) => (a -> b) -> b -> Zipper [] a -> m (Zipper [] a)
seekOnThrow f x ys = do
k <- elemIndexThrow x (f <$> unzipper ys)
return $ seek k ys