NonEmptyZipper.hs

{-# LANGUAGE InstanceSigs        #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}

-----------------------------------------------------------------------------
-- |
-- 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           Control.Lens
import           Data.List.NonEmpty (NonEmpty (..))
import           Data.Semigroup

data NonEmptyZipper a = NonEmptyZipper
    { _before  :: ![a]
    , _current :: !a
    , _after   :: ![a] }
    deriving (Show, Eq, Ord)

makeLenses ''NonEmptyZipper

instance Functor NonEmptyZipper where
    fmap f (NonEmptyZipper xs y zs) =
        NonEmptyZipper (f <$> xs) (f y) (f <$> zs)

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

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