{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Data.List.NonEmptyZipper -- Copyright : (C) 2017 Isaac Shapira -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Isaac Shapira <fresheyeball@gmail.com> -- Stability : provisional -- Portability : portable -- -- Its the Zipper for NonEmpty lists. -- ---------------------------------------------------------------------------- module Data.List.NonEmptyZipper where import Data.List as List import Data.List.NonEmpty (NonEmpty (..)) import Data.Semigroup -- | A Zipper with a "current element". The current element represent a singular, -- focus on a single element in a list. So @NonEmptyZipper [1,2] 3 [4]@ is -- roughly eqivelant to @[1,2,3,4]@, where @3@ is the current element. This is -- useful, since we are now guarenteed that the current element is an element in -- the list. data NonEmptyZipper a = NonEmptyZipper { _before :: ![a] -- ^ A list of elements preceeding the current element. , _current :: !a -- ^ The current element. , _after :: ![a] } -- ^ A list of element succeeding the current element. deriving (Show, Eq, Ord) -- | Make a NonEmptyZipper from a focus item (which will be the head) and ADDITIONAL options. (|:) :: a -> [a] -> NonEmptyZipper a (|:) = NonEmptyZipper [] -- | Create a NonEmptyZipper based on a focused item in a Bounded Enum, -- index position within the Enum will be maintained. nezFromBound :: (Bounded a, Enum a, Eq a) => a -> NonEmptyZipper a nezFromBound x | x == minBound = NonEmptyZipper [] x [succ x..maxBound] | x == maxBound = NonEmptyZipper [minBound..pred x] x [] | otherwise = NonEmptyZipper [minBound..pred x] x [succ x..maxBound] -- | Create a @NonEmptyZipper@ by taking a focused element, and list of options -- If the focused element is not in the list, we get @Nothing@. nezFromOptions :: Eq a => a -> [a] -> Maybe (NonEmptyZipper a) nezFromOptions x xs = (\i -> let (as,_:bs) = splitAt i xs in NonEmptyZipper as x bs) <$> elemIndex x xs -- | Map to @_before@, useful as a lens before :: Functor f => ([a] -> f [a]) -> NonEmptyZipper a -> f (NonEmptyZipper a) before f x = (\c' -> x { _before = c' }) <$> f (_before x) -- | Map to @current@, useful as a lens current :: Functor f => (a -> f a) -> NonEmptyZipper a -> f (NonEmptyZipper a) current f x = (\c' -> x { _current = c' }) <$> f (_current x) -- | Map to @after@, useful as a lens after :: Functor f => ([a] -> f [a]) -> NonEmptyZipper a -> f (NonEmptyZipper a) after f x = (\c' -> x { _after = c' }) <$> f (_after x) -- | Its a Functor instance Functor NonEmptyZipper where fmap f (NonEmptyZipper xs y zs) = NonEmptyZipper (f <$> xs) (f y) (f <$> zs) -- | Its Applicative, but @pure@ might not be what you expect instance Applicative NonEmptyZipper where pure x = NonEmptyZipper [x] x [x] NonEmptyZipper fxs fy fzs <*> NonEmptyZipper xs y zs = NonEmptyZipper (fxs <*> xs) (fy y) (fzs <*> zs) -- | Advance the current element forward by one. -- If the current is the last element in the list, we do nothing. next :: NonEmptyZipper a -> NonEmptyZipper a next (NonEmptyZipper xs y (z:zs)) = NonEmptyZipper (xs <> [y]) z zs next z = z -- | Advance the current element forward by one. -- If the current is the last element in the list, we loop back to the first. nextMod :: NonEmptyZipper a -> NonEmptyZipper a nextMod (NonEmptyZipper (x:xs) y []) = NonEmptyZipper [] x (xs <> [y]) nextMod z = next z -- | Move the current element backward by one. -- If the current is the first element in the list, we do nothing. previous :: NonEmptyZipper a -> NonEmptyZipper a previous (NonEmptyZipper xs y zs) | not (null xs) = NonEmptyZipper (Prelude.init xs) (Prelude.last xs) (y:zs) previous z = z -- | Move the current element backward by one. -- If the current is the first element in the list, we loop to the last element. previousMod :: NonEmptyZipper a -> NonEmptyZipper a previousMod (NonEmptyZipper [] y zs) | not (null zs) = NonEmptyZipper (y:Prelude.init zs) (Prelude.last zs) [] previousMod z = previous z -- | Convert to a standard list. Current element information will be lost. toList :: NonEmptyZipper a -> [a] toList (NonEmptyZipper xs y zs) = xs <> (y:zs) -- | Convert from @NonEmpty@. The first element will be the current element. fromNonEmpty :: NonEmpty a -> NonEmptyZipper a fromNonEmpty (x :| xs) = NonEmptyZipper [] x xs -- | Is the current selection the first item in the collection? inTheBeginning :: NonEmptyZipper a -> Bool inTheBeginning (NonEmptyZipper [] _ _) = True inTheBeginning _ = False -- | Is the current selection the last item in the collection? inTheEnd :: NonEmptyZipper a -> Bool inTheEnd (NonEmptyZipper _ _ []) = True inTheEnd _ = False -- | Get the index of the current element in the collection. getPosition :: NonEmptyZipper a -> Int getPosition (NonEmptyZipper xs _ _) = Prelude.length xs -- | Measure the size of the collection. Will be atleast 1. length :: NonEmptyZipper a -> Int length (NonEmptyZipper xs _ zs) = Prelude.length xs + 1 + Prelude.length zs -- | Its a @Semigroup@ by appending the second -- @NonEmptyZipper@ to the @_after@ list. instance Semigroup (NonEmptyZipper a) where NonEmptyZipper xs y zs <> z = NonEmptyZipper xs y $ zs <> toList z -- | Get the first element out of the NonEmptyZipper. head :: NonEmptyZipper a -> a head = \case NonEmptyZipper [] x _ -> x NonEmptyZipper (x:_) _ _ -> x -- | Get all elements out of the NonEmptyZipper that are not the last element. -- If there is only one element in the collection, it's @Nothing@. init :: NonEmptyZipper a -> Maybe (NonEmptyZipper a) init = \case NonEmptyZipper [] _ [] -> Nothing NonEmptyZipper xs _ [] -> Just $ NonEmptyZipper (Prelude.init xs) (Prelude.last xs) [] NonEmptyZipper xs y zs -> Just $ NonEmptyZipper xs y (Prelude.init zs) -- | Get the last element out of the NonEmptyZipper. last :: NonEmptyZipper a -> a last = \case NonEmptyZipper _ x [] -> x NonEmptyZipper _ _ xs -> Prelude.last xs -- | Get all elements out of the NonEmptyZipper that are not the first element. -- If there is only one element in the collection, its @Nothing@. tail :: NonEmptyZipper a -> Maybe (NonEmptyZipper a) tail = \case NonEmptyZipper [] _ [] -> Nothing NonEmptyZipper (_:xs) y zs -> Just $ NonEmptyZipper xs y zs NonEmptyZipper _ _ (z:zs) -> Just $ NonEmptyZipper [] z zs -- | Flip the NonEmptyZipper, maintaining the current element. reverse :: NonEmptyZipper a -> NonEmptyZipper a reverse (NonEmptyZipper xs y zs) = NonEmptyZipper (Prelude.reverse zs) y (Prelude.reverse xs) -- | Add one element to the front of a NonEmptyZipper. cons :: a -> NonEmptyZipper a -> NonEmptyZipper a cons x (NonEmptyZipper xs y zs) = NonEmptyZipper (x:xs) y zs -- | This is like @pure@ but more intuitive. -- The Applicative instance for @NonEmptyZipper@ is likely not what you expect. wrap :: a -> NonEmptyZipper a wrap x = NonEmptyZipper [] x [] -- | Its Foldable instance Foldable NonEmptyZipper where foldr f i (NonEmptyZipper xs y zs) = foldr f (foldr f (foldr f i zs) [y]) xs -- | Its Traversable instance Traversable NonEmptyZipper where traverse f (NonEmptyZipper xs y zs) = NonEmptyZipper <$> traverse f xs <*> f y <*> traverse f zs -- | Set the current element in the NonEmptyZipper. -- If the element does not appear in the collection, -- the result with be @Nothing@ setCurrent :: Eq a => a -> NonEmptyZipper a -> Maybe (NonEmptyZipper a) setCurrent x xs | x `elem` xs = let (as, bs) = List.break (== x) $ toList xs in Just $ NonEmptyZipper (List.delete x as) x (List.delete x bs) setCurrent _ _ = Nothing -- | Set the current element in the NonEmptyZipper via index location. -- If the index is out of bounds the results will be @Nothing@. setCurrentIndex :: Int -> NonEmptyZipper a -> Maybe (NonEmptyZipper a) setCurrentIndex i xs | List.length xs > i && i >= 0 = let (bs, x:as) = splitAt i $ toList xs in Just $ NonEmptyZipper bs x as setCurrentIndex _ _ = Nothing