pointedlist-0.6.1/0000755000000000000000000000000012326775067012261 5ustar0000000000000000pointedlist-0.6.1/LICENSE0000644000000000000000000000276712326775067013302 0ustar0000000000000000* Copyright (c) 2009, Jeff Wheeler * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of the nor the * names of its contributors may be used to endorse or promote products * derived from this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY ''AS IS'' AND ANY * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE * DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. pointedlist-0.6.1/pointedlist.cabal0000644000000000000000000000152312326775067015604 0ustar0000000000000000Name: pointedlist Version: 0.6.1 Synopsis: A zipper-like comonad which works as a list, tracking a position. Category: Data Description: A PointedList tracks the position in a non-empty list which works similarly to a zipper. A current item is always required, and therefore the list may never be empty. A circular PointedList wraps around to the other end when progressing past the actual edge. License: BSD3 License-file: LICENSE Author: Jeff Wheeler Maintainer: jeffwheeler@gmail.com Build-type: Simple Cabal-version: >= 1.6 Source-repository head type: git location: git://github.com/jeffwheeler/pointedlist.git Library Build-depends: base >= 4 && < 5 Build-depends: binary Exposed-modules: Data.List.PointedList Data.List.PointedList.Circular pointedlist-0.6.1/Setup.hs0000644000000000000000000000025012326775067013712 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.PackageDescription import Distribution.Simple import Distribution.Simple.LocalBuildInfo main :: IO () main = defaultMain pointedlist-0.6.1/Data/0000755000000000000000000000000012326775067013132 5ustar0000000000000000pointedlist-0.6.1/Data/List/0000755000000000000000000000000012326775067014045 5ustar0000000000000000pointedlist-0.6.1/Data/List/PointedList.hs0000644000000000000000000002125512326775067016644 0ustar0000000000000000{-# LANGUAGE TypeOperators #-} -- | An implementation of a zipper-like non-empty list structure that tracks -- an index position in the list (the 'focus'). module Data.List.PointedList where import Prelude hiding (foldl, foldr, elem) import Control.Applicative import Control.Monad import Data.Binary import Data.Foldable hiding (find) import Data.List hiding (length, foldl, foldr, find, elem) import qualified Data.List as List import Data.Traversable -- | The implementation of the pointed list structure which tracks the current -- position in the list structure. data PointedList a = PointedList { _reversedPrefix :: [a] , _focus :: a , _suffix :: [a] } deriving (Eq) instance Binary a => Binary (PointedList a) where put (PointedList x1 x2 x3) = do put x1; put x2; put x3 get = do liftM3 PointedList get get get -- | Lens compatible with Control.Lens. reversedPrefix :: Functor f => ([a] -> f [a]) -> PointedList a -> f (PointedList a) reversedPrefix f (PointedList ls x rs) = (\ls' -> PointedList ls' x rs) <$> f ls -- | Lens compatible with Control.Lens. focus :: Functor f => (a -> f a) -> PointedList a -> f (PointedList a) focus f (PointedList ls x rs) = (\x' -> PointedList ls x' rs) <$> f x -- | Lens compatible with Control.Lens. suffix :: Functor f => ([a] -> f [a]) -> PointedList a -> f (PointedList a) suffix f (PointedList ls x rs) = (\rs' -> PointedList ls x rs') <$> f rs -- | Lens compatible with Control.Lens. -- Internally reversing the prefix list. prefix :: Functor f => ([a] -> f [a]) -> PointedList a -> f (PointedList a) prefix f (PointedList ls x rs) = (\ls' -> PointedList (reverse ls') x rs) <$> f (reverse ls) instance (Show a) => Show (PointedList a) where show (PointedList ls x rs) = show (reverse ls) ++ " " ++ show x ++ " " ++ show rs instance Functor PointedList where fmap f (PointedList ls x rs) = PointedList (map f ls) (f x) (map f rs) instance Foldable PointedList where foldr f z (PointedList ls x rs) = foldl (flip f) (foldr f z (x:rs)) ls instance Traversable PointedList where traverse f (PointedList ls x rs) = PointedList <$> (reverse <$> traverse f (reverse ls)) <*> f x <*> traverse f rs -- | Create a 'PointedList' with a single element. singleton :: a -> PointedList a singleton x = PointedList [] x [] -- | Possibly create a @'Just' 'PointedList'@ if the provided list has at least -- one element; otherwise, return Nothing. -- -- The provided list's head will be the focus of the list, and the rest of -- list will follow on the right side. fromList :: [a] -> Maybe (PointedList a) fromList [] = Nothing fromList (x:xs) = Just $ PointedList [] x xs -- | Possibly create a @'Just' 'PointedList'@ if the provided list has at least -- one element; otherwise, return Nothing. -- -- The provided list's last element will be the focus of the list, following -- the rest of the list in order, to the left. fromListEnd :: [a] -> Maybe (PointedList a) fromListEnd [] = Nothing fromListEnd xs = Just $ PointedList xs' x [] where (x:xs') = reverse xs -- | Replace the focus of the list, retaining the prefix and suffix. replace :: a -> PointedList a -> PointedList a replace x (PointedList ls _ rs) = PointedList ls x rs -- replace = set focus -- | Possibly move the focus to the next element in the list. next :: PointedList a -> Maybe (PointedList a) next (PointedList _ _ []) = Nothing next p = (Just . tryNext) p -- GHC doesn't allow PL form here -- | Attempt to move the focus to the next element, or 'error' if there are -- no more elements. tryNext :: PointedList a -> PointedList a tryNext p@(PointedList _ _ [] ) = error "cannot move to next element" tryNext (PointedList ls x (r:rs)) = PointedList (x:ls) r rs -- | Possibly move the focus to the previous element in the list. previous :: PointedList a -> Maybe (PointedList a) previous (PointedList [] _ _ ) = Nothing previous p = (Just . tryPrevious) p -- | Attempt to move the focus to the previous element, or 'error' if there are -- no more elements. tryPrevious :: PointedList a -> PointedList a tryPrevious p@(PointedList [] _ _ ) = error "cannot move to previous element" tryPrevious (PointedList (l:ls) x rs) = PointedList ls l (x:rs) -- | An alias for 'insertRight'. insert :: a -> PointedList a -> PointedList a insert = insertRight -- | Insert an element to the left of the focus, then move the focus to the new -- element. insertLeft :: a -> PointedList a -> PointedList a insertLeft y (PointedList ls x rs) = PointedList ls y (x:rs) -- | Insert an element to the right of the focus, then move the focus to the -- new element. insertRight :: a -> PointedList a -> PointedList a insertRight y (PointedList ls x rs) = PointedList (x:ls) y rs -- | An alias of 'deleteRight'. delete :: PointedList a -> Maybe (PointedList a) delete = deleteRight -- | Possibly delete the element at the focus, then move the element on the -- left to the focus. If no element is on the left, focus on the element to -- the right. If the deletion will cause the list to be empty, return -- 'Nothing'. deleteLeft :: PointedList a -> Maybe (PointedList a) deleteLeft (PointedList [] _ [] ) = Nothing deleteLeft (PointedList (l:ls) _ rs) = Just $ PointedList ls l rs deleteLeft (PointedList [] _ (r:rs)) = Just $ PointedList [] r rs -- | Possibly delete the element at the focus, then move the element on the -- right to the focus. If no element is on the right, focus on the element to -- the left. If the deletion will cause the list to be empty, return -- 'Nothing'. deleteRight :: PointedList a -> Maybe (PointedList a) deleteRight (PointedList [] _ [] ) = Nothing deleteRight (PointedList ls _ (r:rs)) = Just $ PointedList ls r rs deleteRight (PointedList (l:ls) _ []) = Just $ PointedList ls l [] -- | Delete all elements in the list except the focus. deleteOthers :: PointedList a -> PointedList a deleteOthers (PointedList _ b _) = PointedList [] b [] -- | The length of the list. length :: PointedList a -> Int length = foldr (const (+1)) 0 -- | Whether the focus is the first element. atStart :: PointedList a -> Bool atStart (PointedList [] _ _) = True atStart _ = False -- | Whether the focus is the last element. atEnd :: PointedList a -> Bool atEnd (PointedList _ _ []) = True atEnd _ = False -- | Create a 'PointedList' of variations of the provided 'PointedList', in -- which each element is focused, with the provided 'PointedList' as the -- focus of the sets. positions :: PointedList a -> PointedList (PointedList a) positions p@(PointedList ls x rs) = PointedList left p right where left = unfoldr (\p -> fmap (join (,)) $ previous p) p right = unfoldr (\p -> fmap (join (,)) $ next p) p -- | Map over the 'PointedList's created via 'positions', such that @f@ is -- called with each element of the list focused in the provided -- 'PointedList'. An example makes this easier to understand: -- -- > contextMap atStart (fromJust $ fromList [1..5]) contextMap :: (PointedList a -> b) -> PointedList a -> PointedList b contextMap f z = fmap f $ positions z -- | Create a @'PointedList' a@ of @(a, 'Bool')@, in which the boolean values -- specify whether the current element has the focus. That is, all of the -- booleans will be 'False', except the focused element. withFocus :: PointedList a -> PointedList (a, Bool) withFocus (PointedList a b c) = PointedList (zip a (repeat False)) (b, True) (zip c (repeat False)) -- | Move the focus to the specified index. The first element is at index 0. moveTo :: Int -> PointedList a -> Maybe (PointedList a) moveTo n pl = moveN (n - (index pl)) pl -- | Move the focus by @n@, relative to the current index. Negative values move -- the focus backwards, positive values more forwards through the list. moveN :: Int -> PointedList a -> Maybe (PointedList a) moveN n pl@(PointedList left x right) = go n left x right where go n left x right = case compare n 0 of GT -> case right of [] -> Nothing (r:rs) -> go (n-1) (x:left) r rs LT -> case left of [] -> Nothing (l:ls) -> go (n+1) ls l (x:right) EQ -> Just $ PointedList left x right -- | Move the focus to the specified element, if it is present. -- -- Patch with much faster algorithm provided by Runar Bjarnason for version -- 0.3.2. Improved again by Runar Bjarnason for version 0.3.3 to support -- infinite lists on both sides of the focus. find :: Eq a => a -> PointedList a -> Maybe (PointedList a) find x pl = find' ((x ==) . _focus) $ positions pl where find' pred (PointedList a b c) = if pred b then Just b else List.find pred (merge a c) merge [] ys = ys merge (x:xs) ys = x : merge ys xs -- | The index of the focus, leftmost is 0. index :: PointedList a -> Int index (PointedList a _ _) = Prelude.length a pointedlist-0.6.1/Data/List/PointedList/0000755000000000000000000000000012326775067016303 5ustar0000000000000000pointedlist-0.6.1/Data/List/PointedList/Circular.hs0000644000000000000000000000513212326775067020404 0ustar0000000000000000module Data.List.PointedList.Circular ( -- Re-export many of the regular PointedList features module Data.List.PointedList -- And, of course, export the alternatives here , next , previous , delete , deleteLeft , deleteRight , moveN ) where import Data.List.PointedList ( PointedList(..) , focus , singleton , fromList , fromListEnd , replace , insert , insertLeft , insertRight , deleteOthers , length , positions , contextMap , withFocus , find , index ) import qualified Data.List.PointedList as PL -- | Move the focus to the next element in the list. If the last element is -- currently focused, loop to the first element. next :: PointedList a -> PointedList a next pl@(PointedList [] b []) = pl next (PointedList a b []) = let (x:xs) = reverse a in PointedList [] x (xs ++ [b]) next pl = PL.tryNext pl -- | Move the focus to the previous element in the list. If the first element is -- currently focused, loop to the last element. previous :: PointedList a -> PointedList a previous pl@(PointedList [] b []) = pl previous (PointedList [] b c ) = let (x:xs) = reverse c in PointedList (xs ++ [b]) x [] previous pl = PL.tryPrevious pl -- | An alias of 'deleteRight'. delete :: PointedList a -> Maybe (PointedList a) delete = deleteRight -- | Possibly delete the element at the focus, then move the element on the -- left to the focus. If no element is on the left, focus on the element to -- the right. If the deletion will cause the list to be empty, return -- @Nothing@. deleteLeft :: PointedList a -> Maybe (PointedList a) deleteLeft (PointedList [] _ []) = Nothing deleteLeft (PointedList (l:ls) _ rs) = Just $ PointedList ls l rs deleteLeft (PointedList [] _ rs) = let (x:xs) = reverse rs in Just $ PointedList xs x [] -- | Possibly delete the element at the focus, then move the element on the -- right to the focus. If no element is on the right, focus on the element to -- the left. If the deletion will cause the list to be empty, return -- @Nothing@. deleteRight :: PointedList a -> Maybe (PointedList a) deleteRight (PointedList [] _ [] ) = Nothing deleteRight (PointedList ls _ (r:rs)) = Just $ PointedList ls r rs deleteRight (PointedList ls _ [] ) = let (x:xs) = reverse ls in Just $ PointedList [] x xs -- | Move moveN :: Int -> PointedList a -> PointedList a moveN 0 pl = pl moveN n pl | n > 0 = moveN (n-1) $ next pl | otherwise = moveN (n+1) $ previous pl