NonEmptyZipper.hs

{-# 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
    -- ^ There is only one constructor.
    { _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)


-- | 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


-- | 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