focuslist-0.1.1.0/src/0000755000000000000000000000000014164474547012657 5ustar0000000000000000focuslist-0.1.1.0/src/Data/0000755000000000000000000000000014164730112013507 5ustar0000000000000000focuslist-0.1.1.0/test/0000755000000000000000000000000014164474547013047 5ustar0000000000000000focuslist-0.1.1.0/test/Test/0000755000000000000000000000000014164716451013757 5ustar0000000000000000focuslist-0.1.1.0/test/Test/FocusList/0000755000000000000000000000000014164730112015660 5ustar0000000000000000focuslist-0.1.1.0/test/readme/0000755000000000000000000000000014164474547014304 5ustar0000000000000000focuslist-0.1.1.0/src/Data/FocusList.hs0000644000000000000000000011635414164730112015770 0ustar0000000000000000{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module Data.FocusList ( -- * FocusList FocusList(FocusList, focusListFocus, focusList) -- ** Conversions , fromListFL , fromFoldableFL , toSeqFL -- ** Query , lengthFL , isEmptyFL , getFocusItemFL , lookupFL , indexOfFL , findFL -- *** Query 'Focus' , hasFocusFL , getFocusFL -- ** Manipulate , prependFL , appendFL , appendSetFocusFL , insertFL , removeFL , deleteFL , moveFromToFL , intersperseFL , reverseFL , updateFocusItemFL , setFocusItemFL , -- *** Optics traversalFocusItem -- *** Manipulate 'Focus' , setFocusFL , updateFocusFL -- ** Sort , sortByFL -- ** Construction , emptyFL , singletonFL -- ** Unsafe Functions , unsafeFromListFL , unsafeGetFocusFL , unsafeGetFocusItemFL -- ** Invariants , invariantFL -- ** Testing , genValidFL -- ** Optics -- | These optics allow you to get/set the internal state of a 'FocusList'. -- You should make sure not to directly set the internal state of a -- 'FocusList' unless you are sure that the invariants for the 'FocusList' -- are protected. See 'invariantFL'. , lensFocusListFocus , lensFocusList -- * Focus , Focus(Focus, NoFocus) , hasFocus , getFocus , maybeToFocus , foldFocus -- ** Optics , _Focus , _NoFocus -- ** Unsafe Functions , unsafeGetFocus ) where import Prelude hiding (reverse) import Control.Lens (Prism', Traversal', (^.), (.~), (-~), makeLensesFor, prism') import Data.Foldable (toList) import Data.Function ((&)) import Data.MonoTraversable (Element, GrowingAppend, MonoFoldable, MonoFunctor, MonoTraversable, olength) import qualified Data.Sequence as Sequence import Data.Sequence (Seq((:<|), Empty), (<|), deleteAt, elemIndexL, insertAt, singleton) import Data.Sequences (Index, SemiSequence, cons, find, intersperse, reverse, snoc, sortBy) import GHC.Exts (fromList) import GHC.Generics (Generic) import Test.QuickCheck ( Arbitrary, Arbitrary1, CoArbitrary, Gen, arbitrary, arbitrary1, choose , frequency, liftArbitrary ) -- $setup -- >>> :set -XFlexibleContexts -- >>> :set -XScopedTypeVariables -- >>> import Data.Maybe (isJust) -- >>> import Control.Lens ((^..)) -- | A 'Focus' for the 'FocusList'. -- -- The 'Focus' is either 'NoFocus' (if the 'Focuslist' is empty), or 'Focus' -- 'Int' to represent focusing on a specific element of the 'FocusList'. data Focus = Focus {-# UNPACK #-} !Int | NoFocus deriving (Eq, Generic, Read, Show) -- | 'NoFocus' is always less than 'Focus'. -- -- prop> NoFocus < Focus a -- -- The ordering of 'Focus' depends on the ordering of the integer contained -- inside. -- -- prop> (a < b) ==> (Focus a < Focus b) instance Ord Focus where compare :: Focus -> Focus -> Ordering compare NoFocus NoFocus = EQ compare NoFocus (Focus _) = LT compare (Focus _) NoFocus = GT compare (Focus a) (Focus b) = compare a b instance CoArbitrary Focus instance Arbitrary Focus where arbitrary = frequency [(1, pure NoFocus), (3, fmap Focus arbitrary)] -- | A fold function for 'Focus'. -- -- This is similar to 'maybe' for 'Maybe'. -- -- >>> foldFocus "empty" (\i -> "focus at " <> show i) (Focus 3) -- "focus at 3" -- -- >>> foldFocus Nothing Just NoFocus -- Nothing -- -- prop> foldFocus NoFocus Focus focus == focus foldFocus :: b -> (Int -> b) -> Focus -> b foldFocus b _ NoFocus = b foldFocus _ f (Focus i) = f i -- | A 'Prism'' for focusing on the 'Focus' constructor in a 'Focus' data type. -- -- You can use this to get the 'Int' that is being focused on: -- -- >>> import Control.Lens ((^?)) -- >>> Focus 100 ^? _Focus -- Just 100 -- >>> NoFocus ^? _Focus -- Nothing _Focus :: Prism' Focus Int _Focus = prism' Focus (foldFocus Nothing Just) -- | A 'Prism'' for focusing on the 'NoFocus' constructor in a 'Focus' data type. -- -- >>> import Control.Lens.Extras (is) -- >>> is _NoFocus NoFocus -- True -- >>> is _NoFocus (Focus 3) -- False _NoFocus :: Prism' Focus () _NoFocus = prism' (const NoFocus) (foldFocus (Just ()) (const Nothing)) -- | Returns 'True' if a 'Focus' exists, and 'False' if not. -- -- >>> hasFocus (Focus 0) -- True -- -- >>> hasFocus NoFocus -- False -- -- /complexity/: @O(1)@ hasFocus :: Focus -> Bool hasFocus NoFocus = False hasFocus (Focus _) = True -- | Get the focus index from a 'Focus'. -- -- >>> getFocus (Focus 3) -- Just 3 -- -- >>> getFocus NoFocus -- Nothing -- -- /complexity/: @O(1)@ getFocus :: Focus -> Maybe Int getFocus NoFocus = Nothing getFocus (Focus i) = Just i -- | Convert a 'Maybe' 'Int' to a 'Focus'. -- -- >>> maybeToFocus (Just 100) -- Focus 100 -- -- >>> maybeToFocus Nothing -- NoFocus -- -- 'maybeToFocus' and 'getFocus' witness an isomorphism. -- -- prop> focus == maybeToFocus (getFocus focus) -- -- prop> maybeInt == getFocus (maybeToFocus maybeInt) -- -- /complexity/: @O(1)@ maybeToFocus :: Maybe Int -> Focus maybeToFocus Nothing = NoFocus maybeToFocus (Just i) = Focus i -- | Unsafely get the focus index from a 'Focus'. -- -- Returns an error if 'NoFocus'. -- -- >>> unsafeGetFocus (Focus 50) -- 50 -- -- >>> unsafeGetFocus NoFocus -- *** Exception: ... -- ... -- -- /complexity/: @O(1)@ unsafeGetFocus :: Focus -> Int unsafeGetFocus NoFocus = error "unsafeGetFocus: NoFocus" unsafeGetFocus (Focus i) = i -- | A list with a given element having the 'Focus'. -- -- 'FocusList' has some invariants that must be protected. You should not use -- the 'FocusList' constructor or the 'focusListFocus' or 'focusList' -- accessors. -- -- Implemented under the hood as a 'Seq'. data FocusList a = FocusList { focusListFocus :: !Focus , focusList :: !(Seq a) } deriving (Eq, Functor, Generic) $(makeLensesFor [ ("focusListFocus", "lensFocusListFocus") , ("focusList", "lensFocusList") ] ''FocusList ) -- | A 'Traversal' for the focused item in a 'FocusList'. -- -- This can be used to get the focused item: -- -- >>> import Control.Lens ((^?)) -- >>> let Just fl = fromListFL (Focus 1) ["hello", "bye", "tree"] -- >>> fl ^? traversalFocusItem -- Just "bye" -- >>> emptyFL ^? traversalFocusItem -- Nothing -- -- This can also be used to set the focused item: -- -- >>> import Control.Lens (set) -- >>> let Just fl = fromListFL (Focus 1) ["hello", "bye", "tree"] -- >>> set traversalFocusItem "new val" fl -- FocusList (Focus 1) ["hello","new val","tree"] -- >>> set traversalFocusItem "new val" emptyFL -- FocusList NoFocus [] -- -- Note that this traversal will apply to no elements if the 'FocusList' is -- empty and 'NoFocus'. This traversal will apply to a single element if the -- 'FocusList' has a 'Focus'. This makes 'traversalFocusItem' an affine traversal. -- -- prop> length (fl ^.. traversalFocusItem) <= 1 traversalFocusItem :: forall a. Traversal' (FocusList a) a traversalFocusItem f fl@FocusList {focusListFocus, focusList} = case focusListFocus of NoFocus -> pure fl Focus focus -> case Sequence.lookup focus focusList of Nothing -> error $ "traersalFLItem: internal error, focus (" <> show focus <> ") doesnt exist in sequence" Just a -> fmap (\a' -> setFocusItemFL a' fl) (f a) instance Foldable FocusList where foldr f b (FocusList _ fls) = foldr f b fls length = lengthFL instance Traversable FocusList where traverse :: Applicative f => (a -> f b) -> FocusList a -> f (FocusList b) traverse f (FocusList focus fls) = FocusList focus <$> traverse f fls type instance Element (FocusList a) = a instance MonoFunctor (FocusList a) instance MonoFoldable (FocusList a) where olength = lengthFL instance MonoTraversable (FocusList a) instance GrowingAppend (FocusList a) instance SemiSequence (FocusList a) where type Index (FocusList a) = Int intersperse = intersperseFL reverse = reverseFL find = findFL sortBy = sortByFL cons = prependFL snoc = appendFL -- | Given a 'Gen' for @a@, generate a valid 'FocusList'. genValidFL :: forall a. Gen a -> Gen (FocusList a) genValidFL genA = do newFL <- genFL if invariantFL newFL then pure newFL else error "genValidFL generated an invalid FocusList! This should never happen!" where genFL :: Gen (FocusList a) genFL = do arbList <- liftArbitrary genA case arbList of [] -> pure emptyFL (_:_) -> do let listLen = length arbList len <- choose (0, listLen - 1) pure $ unsafeFromListFL (Focus len) arbList instance Arbitrary1 FocusList where liftArbitrary = genValidFL instance Arbitrary a => Arbitrary (FocusList a) where arbitrary = arbitrary1 instance CoArbitrary a => CoArbitrary (FocusList a) instance Show a => Show (FocusList a) where showsPrec :: Int -> FocusList a -> ShowS showsPrec d FocusList{..} = showParen (d > 10) $ showString "FocusList " . showsPrec 11 focusListFocus . showString " " . showsPrec 11 (toList focusList) -- | Get the underlying 'Seq' in a 'FocusList'. -- -- /complexity/: @O(1)@ toSeqFL :: FocusList a -> Seq a toSeqFL FocusList{focusList = fls} = fls -- | Return the length of a 'FocusList'. -- -- >>> let Just fl = fromListFL (Focus 2) ["hello", "bye", "parrot"] -- >>> lengthFL fl -- 3 -- -- /complexity/: @O(1)@ lengthFL :: FocusList a -> Int lengthFL = length . focusList -- | This is an invariant that the 'FocusList' must always protect. -- -- The functions in this module should generally protect this invariant. If -- they do not, it is generally a bug. -- -- The invariants are as follows: -- -- - The 'Focus' in a 'FocusList' can never be negative. -- -- - If there is a 'Focus', then it actually exists in -- the 'FocusList'. -- -- - There needs to be a 'Focus' if the length of the -- 'FocusList' is greater than 0. -- -- /complexity/: @O(log n)@, where @n@ is the length of the 'FocusList'. invariantFL :: FocusList a -> Bool invariantFL fl = invariantFocusNotNeg && invariantFocusInMap && invariantFocusIfLenGT0 where -- This makes sure that the 'Focus' in a 'FocusList' can never be negative. invariantFocusNotNeg :: Bool invariantFocusNotNeg = case fl ^. lensFocusListFocus of NoFocus -> True Focus i -> i >= 0 -- | This makes sure that if there is a 'Focus', then it actually exists in -- the 'FocusList'. invariantFocusInMap :: Bool invariantFocusInMap = case fl ^. lensFocusListFocus of NoFocus -> length (fl ^. lensFocusList) == 0 Focus i -> case Sequence.lookup i (fl ^. lensFocusList) of Nothing -> False Just _ -> True -- | This makes sure that there needs to be a 'Focus' if the length of the -- 'FocusList' is greater than 0. invariantFocusIfLenGT0 :: Bool invariantFocusIfLenGT0 = let len = lengthFL fl focus = fl ^. lensFocusListFocus in case focus of Focus _ -> len /= 0 NoFocus -> len == 0 -- | Unsafely create a 'FocusList'. This does not check that the focus -- actually exists in the list. This is an internal function and should -- generally not be used. It is only safe to use if you ALREADY know -- the 'Focus' is within the list. -- -- Instead, you should generally use 'fromListFL'. -- -- The following is an example of using 'unsafeFromListFL' correctly. -- -- >>> unsafeFromListFL (Focus 1) [0..2] -- FocusList (Focus 1) [0,1,2] -- -- >>> unsafeFromListFL NoFocus [] -- FocusList NoFocus [] -- -- 'unsafeFromListFL' can also be used uncorrectly. The following is an -- example of 'unsafeFromListFL' allowing you to create a 'FocusList' that does -- not pass 'invariantFL'. -- -- >>> unsafeFromListFL (Focus 100) [0..2] -- FocusList (Focus 100) [0,1,2] -- -- If 'fromListFL' returns a 'Just' 'FocusList', then 'unsafeFromListFL' should -- return the same 'FocusList'. -- -- /complexity/: @O(n)@ where @n@ is the length of the input list. unsafeFromListFL :: Focus -> [a] -> FocusList a unsafeFromListFL focus list = FocusList { focusListFocus = focus , focusList = fromList list } -- | Safely create a 'FocusList' from a list. -- -- >>> fromListFL (Focus 1) ["cat","dog","goat"] -- Just (FocusList (Focus 1) ["cat","dog","goat"]) -- -- >>> fromListFL NoFocus [] -- Just (FocusList NoFocus []) -- -- If the 'Focus' is out of range for the list, then 'Nothing' will be returned. -- -- >>> fromListFL (Focus (-1)) ["cat","dog","goat"] -- Nothing -- -- >>> fromListFL (Focus 3) ["cat","dog","goat"] -- Nothing -- -- >>> fromListFL NoFocus ["cat","dog","goat"] -- Nothing -- -- /complexity/: @O(n)@ where @n@ is the length of the input list. fromListFL :: Focus -> [a] -> Maybe (FocusList a) fromListFL NoFocus [] = Just emptyFL fromListFL _ [] = Nothing fromListFL NoFocus (_:_) = Nothing fromListFL (Focus i) list = let len = length list in if i < 0 || i >= len then Nothing else Just $ FocusList { focusListFocus = Focus i , focusList = fromList list } -- | Create a 'FocusList' from any 'Foldable' container. -- -- This just calls 'toList' on the 'Foldable', and then passes the result to -- 'fromListFL'. -- -- prop> fromFoldableFL foc (foldable :: Data.Sequence.Seq Int) == fromListFL foc (toList foldable) -- -- /complexity/: @O(n)@ where @n@ is the length of the 'Foldable' fromFoldableFL :: Foldable f => Focus -> f a -> Maybe (FocusList a) fromFoldableFL foc as = fromListFL foc (toList as) -- | Create a 'FocusList' with a single element. -- -- >>> singletonFL "hello" -- FocusList (Focus 0) ["hello"] -- -- /complexity/: @O(1)@ singletonFL :: a -> FocusList a singletonFL a = FocusList { focusListFocus = Focus 0 , focusList = singleton a } -- | Create an empty 'FocusList' without a 'Focus'. -- -- >>> emptyFL -- FocusList NoFocus [] -- -- /complexity/: @O(1)@ emptyFL :: FocusList a emptyFL = FocusList { focusListFocus = NoFocus , focusList = mempty } -- | Return 'True' if the 'FocusList' is empty. -- -- >>> isEmptyFL emptyFL -- True -- -- >>> isEmptyFL $ singletonFL "hello" -- False -- -- Any 'FocusList' with a 'Focus' should never be empty. -- -- prop> hasFocusFL fl ==> not (isEmptyFL fl) -- -- The opposite is also true. -- -- /complexity/: @O(1)@ isEmptyFL :: FocusList a -> Bool isEmptyFL fl = (lengthFL fl) == 0 -- | Append a value to the end of a 'FocusList'. -- -- This can be thought of as a \"snoc\" operation. -- -- >>> appendFL emptyFL "hello" -- FocusList (Focus 0) ["hello"] -- -- >>> appendFL (singletonFL "hello") "bye" -- FocusList (Focus 0) ["hello","bye"] -- -- Appending a value to an empty 'FocusList' is the same as using 'singletonFL'. -- -- prop> appendFL emptyFL a == singletonFL a -- -- /complexity/: @O(log n)@ where @n@ is the length of the 'FocusList'. appendFL :: FocusList a -> a -> FocusList a appendFL fl a = if isEmptyFL fl then singletonFL a else insertFL (length $ focusList fl) a fl -- | A combination of 'appendFL' and 'setFocusFL'. -- -- >>> let Just fl = fromListFL (Focus 1) ["hello", "bye", "tree"] -- >>> appendSetFocusFL fl "pie" -- FocusList (Focus 3) ["hello","bye","tree","pie"] -- -- The 'Focus' will always be updated after calling 'appendSetFocusFL'. -- -- prop> getFocusFL (appendSetFocusFL fl a) > getFocusFL fl -- -- /complexity/: @O(log n)@ where @n@ is the length of the 'FocusList'. appendSetFocusFL :: FocusList a -> a -> FocusList a appendSetFocusFL fl a = let oldLen = length $ focusList fl in case setFocusFL oldLen (appendFL fl a) of Nothing -> error "Internal error with setting the focus. This should never happen." Just newFL -> newFL -- | Prepend a value to a 'FocusList'. -- -- This can be thought of as a \"cons\" operation. -- -- >>> prependFL "hello" emptyFL -- FocusList (Focus 0) ["hello"] -- -- The focus will be updated when prepending: -- -- >>> prependFL "bye" (singletonFL "hello") -- FocusList (Focus 1) ["bye","hello"] -- -- Prepending to a 'FocusList' will always update the 'Focus': -- -- prop> getFocusFL fl < getFocusFL (prependFL a fl) -- -- /complexity/: @O(1)@ prependFL :: a -> FocusList a -> FocusList a prependFL a fl@FocusList{ focusListFocus = focus, focusList = fls} = case focus of NoFocus -> singletonFL a Focus i -> fl { focusListFocus = Focus (i+1) , focusList = a <| fls } -- | Unsafely get the 'Focus' from a 'FocusList'. If the 'Focus' is -- 'NoFocus', this function returns 'error'. -- -- This function is only safe if you already have knowledge that -- the 'FocusList' has a 'Focus'. -- -- Generally, 'getFocusFL' should be used instead of this function. -- -- >>> let Just fl = fromListFL (Focus 1) [0..9] -- >>> unsafeGetFocusFL fl -- 1 -- -- >>> unsafeGetFocusFL emptyFL -- *** Exception: ... -- ... -- -- /complexity/: @O(1)@ unsafeGetFocusFL :: FocusList a -> Int unsafeGetFocusFL fl = let focus = fl ^. lensFocusListFocus in case focus of NoFocus -> error "unsafeGetFocusFL: the focus list doesn't have a focus" Focus i -> i -- | Return 'True' if the 'Focus' in a 'FocusList' exists. -- -- Return 'False' if the 'Focus' in a 'FocusList' is 'NoFocus'. -- -- >>> hasFocusFL $ singletonFL "hello" -- True -- -- >>> hasFocusFL emptyFL -- False -- -- /complexity/: @O(1)@ hasFocusFL :: FocusList a -> Bool hasFocusFL = hasFocus . getFocusFL -- | Get the 'Focus' from a 'FocusList'. -- -- >>> getFocusFL $ singletonFL "hello" -- Focus 0 -- -- >>> let Just fl = fromListFL (Focus 3) [0..9] -- >>> getFocusFL fl -- Focus 3 -- -- >>> getFocusFL emptyFL -- NoFocus -- -- /complexity/: @O(1)@ getFocusFL :: FocusList a -> Focus getFocusFL FocusList{focusListFocus} = focusListFocus -- | Unsafely get the value of the 'Focus' from a 'FocusList'. If the 'Focus' is -- 'NoFocus', this function returns 'error'. -- -- This function is only safe if you already have knowledge that the 'FocusList' -- has a 'Focus'. -- -- Generally, 'getFocusItemFL' should be used instead of this function. -- -- >>> let Just fl = fromListFL (Focus 0) ['a'..'c'] -- >>> unsafeGetFocusItemFL fl -- 'a' -- -- >>> unsafeGetFocusFL emptyFL -- *** Exception: ... -- ... -- -- /complexity/: @O(log(min(i, n - i)))@ where @i@ is the 'Focus', and @n@ -- is the length of the 'FocusList'. unsafeGetFocusItemFL :: FocusList a -> a unsafeGetFocusItemFL fl = let focus = fl ^. lensFocusListFocus in case focus of NoFocus -> error "unsafeGetFocusItemFL: the focus list doesn't have a focus" Focus i -> let fls = fl ^. lensFocusList in case Sequence.lookup i fls of Nothing -> error $ "unsafeGetFocusItemFL: internal error, i (" <> show i <> ") doesnt exist in sequence" Just a -> a -- | Get the item the 'FocusList' is focusing on. Return 'Nothing' if the -- 'FocusList' is empty. -- -- >>> let Just fl = fromListFL (Focus 0) ['a'..'c'] -- >>> getFocusItemFL fl -- Just 'a' -- -- >>> getFocusItemFL emptyFL -- Nothing -- -- This will always return 'Just' if there is a 'Focus'. -- -- prop> hasFocusFL fl ==> isJust (getFocusItemFL fl) -- -- /complexity/: @O(log(min(i, n - i)))@ where @i@ is the 'Focus', and @n@ -- is the length of the 'FocusList'. getFocusItemFL :: FocusList a -> Maybe a getFocusItemFL fl = let focus = fl ^. lensFocusListFocus in case focus of NoFocus -> Nothing Focus i -> let fls = fl ^. lensFocusList in case Sequence.lookup i fls of Nothing -> error $ "getFocusItemFL: internal error, i (" <> show i <> ") doesnt exist in sequence" Just a -> Just a -- | Set the item the 'FocusList' is focusing on. -- -- >>> let Just fl = fromListFL (Focus 1) [10, 20, 30] -- >>> setFocusItemFL 0 fl -- FocusList (Focus 1) [10,0,30] -- -- >>> setFocusItemFL "hello" emptyFL -- FocusList NoFocus [] -- -- Note: this function forces the updated item. The following throws an -- exception from 'undefined' even though we updated the focused item at index -- 1, but lookup the item at index 0. -- -- >>> let Just fl = fromListFL (Focus 1) [10, 20, 30] -- >>> let newFl = setFocusItemFL undefined fl -- >>> lookupFL 0 newFl -- *** Exception: ... -- ... -- -- This is a specialization of 'updateFocusItemFL': -- -- prop> updateFocusItemFL (const a) fl == setFocusItemFL a fl -- -- /complexity/: @O(log(min(i, n - i)))@ where @i@ is the 'Focus', and @n@ -- is the length of the 'FocusList'. setFocusItemFL :: a -> FocusList a -> FocusList a setFocusItemFL a fl = updateFocusItemFL (const a) fl -- | Update the item the 'FocusList' is focusing on. Do nothing if -- the 'FocusList' is empty. -- -- >>> let Just fl = fromListFL (Focus 1) [10, 20, 30] -- >>> updateFocusItemFL (\a -> a + 5) fl -- FocusList (Focus 1) [10,25,30] -- -- >>> updateFocusItemFL (\a -> a * 100) emptyFL -- FocusList NoFocus [] -- -- Note: this function forces the updated item. The following throws an -- exception from 'undefined' even though we updated the focused item at index -- 1, but lookup the item at index 0. -- -- >>> let Just fl = fromListFL (Focus 1) [10, 20, 30] -- >>> let newFl = updateFocusItemFL (const undefined) fl -- >>> lookupFL 0 newFl -- *** Exception: ... -- ... -- -- /complexity/: @O(log(min(i, n - i)))@ where @i@ is the 'Focus', and @n@ -- is the length of the 'FocusList'. updateFocusItemFL :: (a -> a) -> FocusList a -> FocusList a updateFocusItemFL f fl = let focus = fl ^. lensFocusListFocus in case focus of NoFocus -> fl Focus i -> let fls = fl ^. lensFocusList in fl { focusList = Sequence.adjust' f i fls } -- | Lookup the element at the specified index, counting from 0. -- -- >>> let Just fl = fromListFL (Focus 0) ['a'..'c'] -- >>> lookupFL 0 fl -- Just 'a' -- -- Returns 'Nothing' if the index is out of bounds. -- -- >>> let Just fl = fromListFL (Focus 0) ['a'..'c'] -- >>> lookupFL 100 fl -- Nothing -- >>> lookupFL (-1) fl -- Nothing -- -- Always returns 'Nothing' if the 'FocusList' is empty. -- -- prop> lookupFL i emptyFL == Nothing -- -- /complexity/: @O(log(min(i, n - i)))@ where @i@ is the index you want to look up, and @n@ -- is the length of the 'FocusList'. lookupFL :: Int -- ^ Index to lookup. -> FocusList a -> Maybe a lookupFL i fl = Sequence.lookup i (fl ^. lensFocusList) -- | Insert a new value into the 'FocusList'. The 'Focus' of the list is -- changed appropriately. -- -- Inserting an element into an empty 'FocusList' will set the 'Focus' on -- that element. -- -- >>> insertFL 0 "hello" emptyFL -- FocusList (Focus 0) ["hello"] -- -- The 'Focus' will not be changed if you insert a new element after the -- current 'Focus'. -- -- >>> insertFL 1 "hello" (singletonFL "bye") -- FocusList (Focus 0) ["bye","hello"] -- -- The 'Focus' will be bumped up by one if you insert a new element before -- the current 'Focus'. -- -- >>> insertFL 0 "hello" (singletonFL "bye") -- FocusList (Focus 1) ["hello","bye"] -- -- Behaves like @Data.Sequence.'Data.Sequence.insertAt'@. If the index is out of bounds, it will be -- inserted at the nearest available index -- -- >>> insertFL 100 "hello" emptyFL -- FocusList (Focus 0) ["hello"] -- -- >>> insertFL 100 "bye" (singletonFL "hello") -- FocusList (Focus 0) ["hello","bye"] -- -- >>> insertFL (-1) "bye" (singletonFL "hello") -- FocusList (Focus 1) ["bye","hello"] -- -- /complexity/: @O(log(min(i, n - i)))@ where @i@ is the index you want to insert at, and @n@ -- is the length of the 'FocusList'. insertFL :: Int -- ^ The index at which to insert the new element. -> a -- ^ The new element. -> FocusList a -> FocusList a insertFL _ a FocusList {focusListFocus = NoFocus} = singletonFL a insertFL i a fl@FocusList{focusListFocus = Focus focus, focusList = fls} = if i > focus then fl { focusList = insertAt i a fls } else fl { focusList = insertAt i a fls , focusListFocus = Focus $ focus + 1 } -- | Remove an element from a 'FocusList'. -- -- If the element to remove is not the 'Focus', then update the 'Focus' -- accordingly. -- -- For example, if the 'Focus' is on index 1, and we have removed index 2, then -- the focus is not affected, so it is not changed. -- -- >>> let focusList = unsafeFromListFL (Focus 1) ["cat","goat","dog","hello"] -- >>> removeFL 2 focusList -- Just (FocusList (Focus 1) ["cat","goat","hello"]) -- -- If the 'Focus' is on index 2 and we have removed index 1, then the 'Focus' -- will be moved back one element to set to index 1. -- -- >>> let focusList = unsafeFromListFL (Focus 2) ["cat","goat","dog","hello"] -- >>> removeFL 1 focusList -- Just (FocusList (Focus 1) ["cat","dog","hello"]) -- -- If we remove the 'Focus', then the next item is set to have the 'Focus'. -- -- >>> let focusList = unsafeFromListFL (Focus 0) ["cat","goat","dog","hello"] -- >>> removeFL 0 focusList -- Just (FocusList (Focus 0) ["goat","dog","hello"]) -- -- If the element to remove is the only element in the list, then the 'Focus' -- will be set to 'NoFocus'. -- -- >>> let focusList = unsafeFromListFL (Focus 0) ["hello"] -- >>> removeFL 0 focusList -- Just (FocusList NoFocus []) -- -- If the 'Int' for the index to remove is either less than 0 or greater then -- the length of the list, then 'Nothing' is returned. -- -- >>> let focusList = unsafeFromListFL (Focus 0) ["hello"] -- >>> removeFL (-1) focusList -- Nothing -- -- >>> let focusList = unsafeFromListFL (Focus 1) ["hello","bye","cat"] -- >>> removeFL 3 focusList -- Nothing -- -- If the 'FocusList' passed in is 'Empty', then 'Nothing' is returned. -- -- >>> removeFL 0 emptyFL -- Nothing -- -- /complexity/: @O(log(min(i, n - i)))@ where @i@ is index of the element to remove, and @n@ -- is the length of the 'FocusList'. removeFL :: Int -- ^ Index of the element to remove from the 'FocusList'. -> FocusList a -- ^ The 'FocusList' to remove an element from. -> Maybe (FocusList a) removeFL i fl@FocusList{focusList = fls} | i < 0 || i >= (lengthFL fl) || isEmptyFL fl = -- Return Nothing if the removal position is out of bounds. Nothing | lengthFL fl == 1 = -- Return an empty focus list if there is currently only one element Just emptyFL | otherwise = let newFL = fl {focusList = deleteAt i fls} focus = unsafeGetFocusFL fl in if focus >= i && focus /= 0 then Just $ newFL & lensFocusListFocus . _Focus -~ 1 else Just newFL -- | Find the index of the first element in the 'FocusList'. -- -- >>> let Just fl = fromListFL (Focus 1) ["hello", "bye", "tree"] -- >>> indexOfFL "hello" fl -- Just 0 -- -- If more than one element exists, then return the index of the first one. -- -- >>> let Just fl = fromListFL (Focus 1) ["dog", "cat", "cat"] -- >>> indexOfFL "cat" fl -- Just 1 -- -- If the element doesn't exist, then return 'Nothing' -- -- >>> let Just fl = fromListFL (Focus 1) ["foo", "bar", "baz"] -- >>> indexOfFL "hogehoge" fl -- Nothing indexOfFL :: Eq a => a -> FocusList a -> Maybe Int indexOfFL a FocusList{focusList = fls} = elemIndexL a fls -- | Delete an element from a 'FocusList'. -- -- >>> let Just fl = fromListFL (Focus 0) ["hello", "bye", "tree"] -- >>> deleteFL "bye" fl -- FocusList (Focus 0) ["hello","tree"] -- -- The focus will be updated if an item before it is deleted. -- -- >>> let Just fl = fromListFL (Focus 1) ["hello", "bye", "tree"] -- >>> deleteFL "hello" fl -- FocusList (Focus 0) ["bye","tree"] -- -- If there are multiple matching elements in the 'FocusList', remove them all. -- -- >>> let Just fl = fromListFL (Focus 0) ["hello", "bye", "bye"] -- >>> deleteFL "bye" fl -- FocusList (Focus 0) ["hello"] -- -- If there are no matching elements, return the original 'FocusList'. -- -- >>> let Just fl = fromListFL (Focus 2) ["hello", "good", "bye"] -- >>> deleteFL "frog" fl -- FocusList (Focus 2) ["hello","good","bye"] deleteFL :: forall a. (Eq a) => a -> FocusList a -> FocusList a deleteFL item = go where go :: FocusList a -> FocusList a go fl = let maybeIndex = indexOfFL item fl in case maybeIndex of Nothing -> fl Just i -> let maybeNewFL = removeFL i fl in case maybeNewFL of Nothing -> fl Just newFL -> go newFL -- | Set the 'Focus' for a 'FocusList'. -- -- This is just like 'updateFocusFL', but doesn't return the newly focused item. -- -- prop> setFocusFL i fl == fmap snd (updateFocusFL i fl) -- -- /complexity/: @O(1)@ setFocusFL :: Int -> FocusList a -> Maybe (FocusList a) setFocusFL i fl -- Can't set a 'Focus' for an empty 'FocusList'. | isEmptyFL fl = Nothing | otherwise = let len = lengthFL fl in if i < 0 || i >= len then Nothing else Just $ fl & lensFocusListFocus . _Focus .~ i -- | Update the 'Focus' for a 'FocusList' and get the new focused element. -- -- >>> updateFocusFL 1 =<< fromListFL (Focus 2) ["hello","bye","dog","cat"] -- Just ("bye",FocusList (Focus 1) ["hello","bye","dog","cat"]) -- -- If the 'FocusList' is empty, then return 'Nothing'. -- -- >>> updateFocusFL 1 emptyFL -- Nothing -- -- If the new focus is less than 0, or greater than or equal to the length of -- the 'FocusList', then return 'Nothing'. -- -- >>> updateFocusFL (-1) =<< fromListFL (Focus 2) ["hello","bye","dog","cat"] -- Nothing -- -- >>> updateFocusFL 4 =<< fromListFL (Focus 2) ["hello","bye","dog","cat"] -- Nothing -- -- /complexity/: @O(log(min(i, n - i)))@ where @i@ is the new index to put the 'Focus' on, -- and @n@ -- is the length of the 'FocusList'. updateFocusFL :: Int -- ^ The new index to put the 'Focus' on. -> FocusList a -> Maybe (a, FocusList a) -- ^ A tuple of the new element that gets the 'Focus', and the new -- 'FocusList'. updateFocusFL i fl | isEmptyFL fl = Nothing | otherwise = let len = lengthFL fl in if i < 0 || i >= len then Nothing else let newFL = fl & lensFocusListFocus . _Focus .~ i in Just (unsafeGetFocusItemFL newFL, newFL) -- | Find a value in a 'FocusList'. Similar to @Data.List.'Data.List.find'@. -- -- >>> let Just fl = fromListFL (Focus 1) ["hello", "bye", "tree"] -- >>> findFL (\a -> a == "hello") fl -- Just "hello" -- -- This will only find the first value. -- -- >>> let Just fl = fromListFL (Focus 0) ["hello", "bye", "bye"] -- >>> findFL (\a -> a == "bye") fl -- Just "bye" -- -- If no values match the comparison, this will return 'Nothing'. -- -- >>> let Just fl = fromListFL (Focus 1) ["hello", "bye", "parrot"] -- >>> findFL (\a -> a == "ball") fl -- Nothing -- -- /complexity/: @O(n)@ where @n@ is the length of the 'FocusList'. findFL :: (a -> Bool) -> FocusList a -> Maybe (a) findFL p fl = let fls = fl ^. lensFocusList in find p fls -- | Move an existing item in a 'FocusList' to a new index. -- -- The 'Focus' gets updated appropriately when moving items. -- -- >>> let Just fl = fromListFL (Focus 1) ["hello", "bye", "parrot"] -- >>> moveFromToFL 0 1 fl -- Just (FocusList (Focus 0) ["bye","hello","parrot"]) -- -- The 'Focus' may not get updated if it is not involved. -- -- >>> let Just fl = fromListFL (Focus 0) ["hello", "bye", "parrot"] -- >>> moveFromToFL 1 2 fl -- Just (FocusList (Focus 0) ["hello","parrot","bye"]) -- -- If the element with the 'Focus' is moved, then the 'Focus' will be updated -- appropriately. -- -- >>> let Just fl = fromListFL (Focus 2) ["hello", "bye", "parrot"] -- >>> moveFromToFL 2 0 fl -- Just (FocusList (Focus 0) ["parrot","hello","bye"]) -- -- If the index of the item to move is out bounds, then 'Nothing' will be returned. -- -- >>> let Just fl = fromListFL (Focus 2) ["hello", "bye", "parrot"] -- >>> moveFromToFL 3 0 fl -- Nothing -- -- If the new index is out of bounds, then 'Nothing' wil be returned. -- -- >>> let Just fl = fromListFL (Focus 2) ["hello", "bye", "parrot"] -- >>> moveFromToFL 1 (-1) fl -- Nothing -- -- /complexity/: @O(log n)@ where @n@ is the length of the 'FocusList'. moveFromToFL :: Show a => Int -- ^ Index of the item to move. -> Int -- ^ New index for the item. -> FocusList a -> Maybe (FocusList a) moveFromToFL oldPos newPos fl | oldPos < 0 || oldPos >= length fl = Nothing | newPos < 0 || newPos >= length fl = Nothing | otherwise = let oldFocus = fl ^. lensFocusListFocus in case lookupFL oldPos fl of Nothing -> error "moveFromToFL should have been able to lookup the item" Just item -> case removeFL oldPos fl of Nothing -> error "moveFromToFL should have been able to remove old position" Just flAfterRemove -> let flAfterInsert = insertFL newPos item flAfterRemove in if Focus oldPos == oldFocus then case setFocusFL newPos flAfterInsert of Nothing -> error "moveFromToFL should have been able to reset the focus" Just flWithUpdatedFocus -> Just flWithUpdatedFocus else Just flAfterInsert -- | Intersperse a new element between existing elements in the 'FocusList'. -- -- >>> let Just fl = fromListFL (Focus 0) ["hello", "bye", "cat"] -- >>> intersperseFL "foo" fl -- FocusList (Focus 0) ["hello","foo","bye","foo","cat"] -- -- The 'Focus' is updated accordingly. -- -- >>> let Just fl = fromListFL (Focus 2) ["hello", "bye", "cat", "goat"] -- >>> intersperseFL "foo" fl -- FocusList (Focus 4) ["hello","foo","bye","foo","cat","foo","goat"] -- -- The item with the 'Focus' should never change after calling 'intersperseFL'. -- -- prop> getFocusItemFL (fl :: FocusList Int) == getFocusItemFL (intersperseFL a fl) -- -- 'intersperseFL' should not have any effect on a 'FocusList' with less than -- two items. -- -- prop> emptyFL == intersperseFL x emptyFL -- prop> singletonFL a == intersperseFL x (singletonFL a) -- -- /complexity/: @O(n)@ where @n@ is the length of the 'FocusList'. intersperseFL :: a -> FocusList a -> FocusList a intersperseFL _ FocusList{focusListFocus = NoFocus} = emptyFL intersperseFL a FocusList{focusList = fls, focusListFocus = Focus foc} = let newFLS = intersperse a fls in FocusList { focusList = newFLS , focusListFocus = Focus (foc * 2) } -- | Reverse a 'FocusList'. The 'Focus' is updated accordingly. -- -- >>> let Just fl = fromListFL (Focus 0) ["hello", "bye", "cat"] -- >>> reverseFL fl -- FocusList (Focus 2) ["cat","bye","hello"] -- -- >>> let Just fl = fromListFL (Focus 2) ["hello", "bye", "cat", "goat"] -- >>> reverseFL fl -- FocusList (Focus 1) ["goat","cat","bye","hello"] -- -- The item with the 'Focus' should never change after calling 'intersperseFL'. -- -- prop> getFocusItemFL (fl :: FocusList Int) == getFocusItemFL (reverseFL fl) -- -- Reversing twice should not change anything. -- -- prop> (fl :: FocusList Int) == reverseFL (reverseFL fl) -- -- Reversing empty lists and single lists should not do anything. -- -- prop> emptyFL == reverseFL emptyFL -- prop> singletonFL a == reverseFL (singletonFL a) -- -- /complexity/: @O(n)@ where @n@ is the length of the 'FocusList'. reverseFL :: FocusList a -> FocusList a reverseFL FocusList{focusListFocus = NoFocus} = emptyFL reverseFL FocusList{focusList = fls, focusListFocus = Focus foc} = let newFLS = reverse fls newFLSLen = length newFLS in FocusList { focusList = newFLS , focusListFocus = Focus (newFLSLen - foc - 1) } -- | Sort a 'FocusList'. -- -- The 'Focus' will stay with the element that has the 'Focus'. -- -- >>> let Just fl = fromListFL (Focus 2) ["b", "c", "a"] -- >>> sortByFL compare fl -- FocusList (Focus 0) ["a","b","c"] -- -- Nothing will happen if you try to sort an empty 'FocusList', or a -- 'FocusList' with only one element. -- -- prop> emptyFL == sortByFL compare emptyFL -- prop> singletonFL a == sortByFL compare (singletonFL a) -- -- The element with the 'Focus' should be the same before and after sorting. -- -- prop> getFocusItemFL (fl :: FocusList Int) == getFocusItemFL (sortByFL compare fl) -- -- Sorting a 'FocusList' and getting the underlying 'Seq' should be the same as -- getting the underlying 'Seq' and then sorting it. -- -- prop> toSeqFL (sortByFL compare (fl :: FocusList Int)) == sortBy compare (toSeqFL fl) -- -- __WARNING__: The computational complexity for this is very bad. It should be -- able to be done in @O(n * log n)@, but the current implementation is -- @O(n^2)@ (or worse), where @n@ is the length of the 'FocusList'. This -- function could be implemented the same way -- @Data.Sequence.'Data.Sequence.sortBy'@ is implemented. However, a small -- change needs to be added to that function to keep track of the 'Focus' in -- the 'FocusList' and make sure it gets updated properly. If you're -- interested in fixing this, please send a PR. sortByFL :: forall a . (a -> a -> Ordering) -- ^ The function to use to compare elements. -> FocusList a -> FocusList a sortByFL _ FocusList{focusListFocus = NoFocus} = emptyFL sortByFL cmpFunc FocusList{focusList = fls, focusListFocus = Focus foc} = let (res, maybeNewFoc) = go fls (Just foc) in case maybeNewFoc of Nothing -> error "sortByFL: A sequence should never lose its focus." Just newFoc -> FocusList { focusList = res , focusListFocus = Focus newFoc } where go :: Seq a -- ^ The sequence that needs to be sorted. -> Maybe Int -- ^ Whether or not we are tracking a 'Focus' that needs to be updated. -> (Seq a, Maybe Int) -- Trying to sort an empty sequence with a 'Focus'. This should never happen. go Empty (Just _) = error "sortByFL: go: this should never happen, sort empty with focus." -- Trying to sort an empty sequence. go Empty Nothing = (Empty, Nothing) -- Trying to sort a non-empty sequence with no focus. go (a :<| as) Nothing = let res = go as Nothing in case res of (_, Just _) -> error "sortByFL: go: this should never happen, no focus case" (Empty, Nothing) -> (a :<| Empty, Nothing) (b :<| bs, Nothing) -> case cmpFunc a b of LT -> (a :<| b :<| bs, Nothing) EQ -> (a :<| b :<| bs, Nothing) GT -> (b :<| fst (go (a :<| bs) Nothing), Nothing) -- Trying to sort a non-empty sequence with the top element having the focus. go (a :<| as) (Just 0) = let res = go as Nothing in case res of (_, Just _) -> error "sortByFL: go: this should never happen, top elem has focus case" (Empty, Nothing) -> (a :<| Empty, Just 0) (b :<| bs, Nothing) -> case cmpFunc a b of LT -> (a :<| b :<| bs, Just 0) EQ -> (a :<| b :<| bs, Just 0) GT -> let (newSeq, maybeNewFoc) = go (a :<| bs) (Just 0) in case maybeNewFoc of Nothing -> error "sortByFL: go: this should never happen, lost the focus" Just newFoc -> (b :<| newSeq, Just (newFoc + 1)) -- Trying to sort a non-empty sequence where some element other than the -- top element has the focus. go (a :<| as) (Just n) = let res = go as (Just (n - 1)) in case res of (_, Nothing) -> error "sortByFL: go: this should never happen, no focus" (Empty, Just _) -> error "sortByFL: go: this should never happen, focus but no elems" (b :<| bs, Just newFoc) -> case cmpFunc a b of LT -> (a :<| b :<| bs, Just (newFoc + 1)) EQ -> (a :<| b :<| bs, Just (newFoc + 1)) GT -> case newFoc of 0 -> (b :<| fst (go (a :<| bs) Nothing), Just 0) gt0 -> let (newSeq, maybeNewFoc') = go (a :<| bs) (Just gt0) in case maybeNewFoc' of Nothing -> error "sortByFL: go: this should never happen, lost the focus again" Just newFoc' -> (b :<| newSeq, Just (newFoc' + 1)) focuslist-0.1.1.0/test/readme/README.lhs0000644000000000000000000000640414164474547015755 0ustar0000000000000000FocusList ========= [![Build Status](https://secure.travis-ci.org/cdepillabout/focuslist.svg)](http://travis-ci.org/cdepillabout/focuslist) [![Hackage](https://img.shields.io/hackage/v/focuslist.svg)](https://hackage.haskell.org/package/focuslist) [![Stackage LTS](http://stackage.org/package/focuslist/badge/lts)](http://stackage.org/lts/package/focuslist) [![Stackage Nightly](http://stackage.org/package/focuslist/badge/nightly)](http://stackage.org/nightly/package/focuslist) [![BSD3 license](https://img.shields.io/badge/license-BSD3-blue.svg)](./LICENSE) A `FocusList` is a sequence of elements which has one element as its `Focus`. It supports quick insertion and indexing by its implementation with [`Seq`](http://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Sequence.html#t:Seq). The focuslist package is similar to [pointed-list](http://hackage.haskell.org/package/pointedlist-0.6.1) or [list-zipper](http://hackage.haskell.org/package/ListZipper). Focuslist however is optimised for fast indexing and insertion at any point, and can be empty. For operations where linked lists perform better the other packages are likely to be superior, though for other operations focuslist is likely to be faster. ## Example Here is a short example of using `FocusList`. ```haskell module Main where import Data.FocusList ( Focus(Focus), FocusList, appendFL, fromListFL, getFocusItemFL, prependFL , singletonFL ) import Data.Foldable (toList) -- | Create a new 'FocusList' from a list. You must set the 'Focus' of the new -- 'FocusList'. The 'Focus' is counting from zero, so the @goat@ element should -- have the 'Focus'. -- -- If you try to specify a 'Focus' out of range from the input list, -- 'fromListFL' will return 'Nothing'. myFocusList :: Maybe (FocusList String) myFocusList = fromListFL (Focus 2) ["hello", "bye", "goat", "dog"] -- | You can get the focused element from an existing 'FocusList' -- -- If the 'FocusList' is empty, this returns 'Nothing'. myFocusElement :: FocusList String -> Maybe String myFocusElement focuslist = getFocusItemFL focuslist -- | You can append to either side of a 'FocusList'. -- -- 'singletonFL' creates a 'FocusList' with a single element. -- That single element will have the 'Focus'. -- -- 'myFocusListAppended' will have a value of -- @FocusList (Focus 1) ["bye", "hello", "foobar"]@ myFocusListAppended :: FocusList String myFocusListAppended = prependFL "bye" (appendFL (singletonFL "hello") "foobar") -- | 'FocusList' is an instance of 'Functor' and 'Foldable', so you can use -- functions like 'fmap' and 'toList' on a 'FocusList'. fmapAndConvertToList :: FocusList Int -> [String] fmapAndConvertToList focuslist = toList (fmap show focuslist) main :: IO () main = do putStrLn "myFocusList:" print myFocusList putStrLn "\nmyFocusListAppended:" print myFocusListAppended putStrLn "\nmyFocusElement myFocusListAppended:" print (myFocusElement myFocusListAppended) putStrLn "\nfmap length myFocusListAppended:" print (fmap length myFocusListAppended) putStrLn "\nfmapAndConvertToList (fmap length myFocusListAppended):" print (fmapAndConvertToList (fmap length myFocusListAppended)) ``` ## Maintainers - [Grendel-Grendel-Grendel](https://github.com/Grendel-Grendel-Grendel) - [cdepillabout](https://github.com/cdepillabout) focuslist-0.1.1.0/test/Test.hs0000644000000000000000000000050114164474547014316 0ustar0000000000000000 module Main where import Test.Tasty (TestTree, defaultMain, testGroup) import Test.FocusList (focusListTestsIO) main :: IO () main = do tests <- testsIO defaultMain tests testsIO :: IO TestTree testsIO = do focusListTests <- focusListTestsIO pure $ testGroup "tests" [ focusListTests ] focuslist-0.1.1.0/test/Test/FocusList.hs0000644000000000000000000000250014164716451016223 0ustar0000000000000000{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.FocusList where import Data.GenValidity.Sequence () import Test.Hspec (Spec) import Test.QuickCheck (Gen) import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testProperty) import Test.Tasty.Hspec (testSpec) import Test.Validity (GenInvalid, GenUnchecked, GenValid(genValid), Validity(validate), check, eqSpec, genValidSpec) import Data.FocusList (Focus, FocusList, genValidFL, invariantFL) import Test.FocusList.Invariants (testInvariantsInFocusList) instance GenUnchecked Focus instance GenUnchecked a => GenUnchecked (FocusList a) instance Validity (FocusList a) where validate fl = check (invariantFL fl) "the FocusList has been constructed correctly" instance (GenValid a, GenUnchecked a) => GenValid (FocusList a) where genValid :: Gen (FocusList a) genValid = genValidFL genValid instance (GenInvalid a, GenUnchecked a) => GenInvalid (FocusList a) focusListTestsIO :: IO TestTree focusListTestsIO = do specs <- testSpec "validity tests" validitySpec pure $ testGroup "FocusList" [ testProperty "invariants in FocusList" testInvariantsInFocusList , specs ] validitySpec :: Spec validitySpec = do eqSpec @(FocusList String) genValidSpec @(FocusList String) focuslist-0.1.1.0/test/Test/FocusList/Invariants.hs0000644000000000000000000000706614164730112020343 0ustar0000000000000000 module Test.FocusList.Invariants where import Data.Maybe (catMaybes) import Hedgehog ( Gen , Property , PropertyT , annotate , annotateShow , failure , forAll , property , success ) import Hedgehog.Gen (alphaNum, choice, int, string) import Hedgehog.Range (constant, linear) import Data.FocusList ( FocusList , deleteFL , emptyFL , insertFL , invariantFL , isEmptyFL , lengthFL , lookupFL , removeFL ) testInvariantsInFocusList :: Property testInvariantsInFocusList = property $ do numOfActions <- forAll $ int (linear 1 200) let initialState = emptyFL let strGen = string (constant 0 25) alphaNum -- traceM "----------------------------------" -- traceM $ "starting bar, numOfActions: " <> show numOfActions runActions numOfActions strGen initialState data Action a = InsertFL Int a | RemoveFL Int | DeleteFL a deriving (Eq, Show) genInsertFL :: Gen a -> FocusList a -> Maybe (Gen (Action a)) genInsertFL valGen fl | isEmptyFL fl = Just $ do val <- valGen pure $ InsertFL 0 val | otherwise = Just $ do let len = lengthFL fl key <- int $ constant 0 len val <- valGen pure $ InsertFL key val genRemoveFL :: FocusList a -> Maybe (Gen (Action a)) genRemoveFL fl | isEmptyFL fl = Nothing | otherwise = Just $ do let len = lengthFL fl keyToRemove <- int $ constant 0 (len - 1) pure $ RemoveFL keyToRemove genDeleteFL :: Show a => FocusList a -> Maybe (Gen (Action a)) genDeleteFL fl | isEmptyFL fl = Nothing | otherwise = Just $ do let len = lengthFL fl keyForItemToDelete <- int $ constant 0 (len - 1) let maybeItemToDelete = lookupFL keyForItemToDelete fl case maybeItemToDelete of Nothing -> let msg = "Could not find item in focuslist even though " <> "it should be there." <> "\nkey: " <> show keyForItemToDelete <> "\nfocus list: " <> show fl in error msg Just item -> pure $ DeleteFL item generateAction :: Show a => Gen a -> FocusList a -> Gen (Action a) generateAction valGen fl = do let generators = catMaybes [ genInsertFL valGen fl , genRemoveFL fl , genDeleteFL fl ] case generators of [] -> let msg = "No generators available for fl:\n" <> show fl in error msg _ -> do choice generators performAction :: Eq a => FocusList a -> Action a -> Maybe (FocusList a) performAction fl (InsertFL key val) = Just $ insertFL key val fl performAction fl (RemoveFL keyToRemove) = removeFL keyToRemove fl performAction fl (DeleteFL valToDelete) = Just $ deleteFL valToDelete fl runActions :: (Eq a, Monad m, Show a) => Int -> Gen a -> FocusList a -> PropertyT m () runActions i valGen startingFL | i <= 0 = success | otherwise = do action <- forAll $ generateAction valGen startingFL -- traceM $ "runActions, startingFL: " <> show startingFL -- traceM $ "runActions, action: " <> show action let maybeEndingFL = performAction startingFL action case maybeEndingFL of Nothing -> do annotate "Failed to perform action." annotateShow startingFL annotateShow action failure Just endingFL -> if invariantFL endingFL then runActions (i - 1) valGen endingFL else do annotate "Ending FocusList failed invariants." annotateShow startingFL annotateShow action annotateShow endingFL failure focuslist-0.1.1.0/test/DocTest.hs0000644000000000000000000000032614164474547014751 0ustar0000000000000000 module Main where import Build_doctests (flags, pkgs, module_sources) import Test.DocTest (doctest) main :: IO () main = do doctest args where args :: [String] args = flags ++ pkgs ++ module_sources focuslist-0.1.1.0/LICENSE0000644000000000000000000000276714164474547013111 0ustar0000000000000000Copyright Dennis Gosnell (c) 2018 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 Author name here nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 THE COPYRIGHT OWNER OR CONTRIBUTORS 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. focuslist-0.1.1.0/Setup.hs0000644000000000000000000000204314164474547013523 0ustar0000000000000000-- This file comes from cabal-doctest: -- https://github.com/phadej/cabal-doctest/blob/master/simple-example -- -- It is needed so that doctest can be run with the same options as the modules -- are compiled with. {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} module Main (main) where #ifndef MIN_VERSION_cabal_doctest #define MIN_VERSION_cabal_doctest(x,y,z) 0 #endif #if MIN_VERSION_cabal_doctest(1,0,0) import Distribution.Extra.Doctest ( defaultMainWithDoctests ) main :: IO () main = defaultMainWithDoctests "focuslist-doctests" #else #ifdef MIN_VERSION_Cabal -- If the macro is defined, we have new cabal-install, -- but for some reason we don't have cabal-doctest in package-db -- -- Probably we are running cabal sdist, when otherwise using new-build -- workflow #warning You are configuring this package without cabal-doctest installed. \ The doctests test-suite will not work as a result. \ To fix this, install cabal-doctest before configuring. #endif import Distribution.Simple main :: IO () main = defaultMain #endif focuslist-0.1.1.0/focuslist.cabal0000644000000000000000000000767514164730112015065 0ustar0000000000000000name: focuslist version: 0.1.1.0 synopsis: Lists with a focused element description: Please see . homepage: https://github.com/cdepillabout/focuslist license: BSD3 license-file: LICENSE author: Dennis Gosnell and Grendel-Grendel-Grendel maintainer: cdep.illabout@gmail.com copyright: 2017-2018 Dennis Gosnell category: Text build-type: Custom cabal-version: 1.12 extra-source-files: README.md , CHANGELOG.md custom-setup setup-depends: base , Cabal , cabal-doctest >=1.0.2 && <1.1 -- This flag builds the example from the README.md file. It is only used for -- testing. It should be enabled for CI. flag buildreadme description: Build the example from the README.md file. This is normally only used for testing. default: False library hs-source-dirs: src exposed-modules: Data.FocusList build-depends: base >= 4.9 && < 5 , containers >= 0.5.8 , lens >= 4.16 , mono-traversable , QuickCheck >= 2.11.3 default-language: Haskell2010 ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates test-suite focuslist-doctests type: exitcode-stdio-1.0 main-is: DocTest.hs -- other-modules: Build_doctests hs-source-dirs: test build-depends: base , doctest , QuickCheck , template-haskell default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N test-suite focuslist-test type: exitcode-stdio-1.0 main-is: Test.hs hs-source-dirs: test other-modules: Test.FocusList , Test.FocusList.Invariants build-depends: base , focuslist -- genvalidity >= 1.0.0.0 makes some big changes, like -- dropping the GenInvalid and GenUnchecked classes, as -- well as changing the default implementation of methods -- in the GenValid class. , genvalidity < 1.0.0.0 , genvalidity-containers >= 0.5 , genvalidity-hspec >= 0.6 , hedgehog >= 0.6.1 , hspec , lens , QuickCheck , tasty >= 1.1 , tasty-hedgehog >= 0.2 , tasty-hspec >= 1.1 -- See note above about genvalidity. genvalidity -- doesn't have correct lower bounds on validity. , validity < 0.12.0.0 default-language: Haskell2010 ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -threaded -rtsopts -with-rtsopts=-N executable focuslist-readme main-is: README.lhs hs-source-dirs: test/readme build-depends: base , focuslist , markdown-unlit ghc-options: -pgmL markdown-unlit default-language: Haskell2010 if flag(buildreadme) buildable: True else buildable: False source-repository head type: git location: https://github.com/cdepillabout/focuslist/ -- benchmark termonad-bench -- type: exitcode-stdio-1.0 -- main-is: Bench.hs -- hs-source-dirs: bench -- build-depends: base -- , criterion -- , termonad -- default-language: Haskell2010 -- ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N source-repository head type: git location: git@github.com:cdepillabout/focuslist.git focuslist-0.1.1.0/README.md0000644000000000000000000000640414164474547013353 0ustar0000000000000000FocusList ========= [![Build Status](https://secure.travis-ci.org/cdepillabout/focuslist.svg)](http://travis-ci.org/cdepillabout/focuslist) [![Hackage](https://img.shields.io/hackage/v/focuslist.svg)](https://hackage.haskell.org/package/focuslist) [![Stackage LTS](http://stackage.org/package/focuslist/badge/lts)](http://stackage.org/lts/package/focuslist) [![Stackage Nightly](http://stackage.org/package/focuslist/badge/nightly)](http://stackage.org/nightly/package/focuslist) [![BSD3 license](https://img.shields.io/badge/license-BSD3-blue.svg)](./LICENSE) A `FocusList` is a sequence of elements which has one element as its `Focus`. It supports quick insertion and indexing by its implementation with [`Seq`](http://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Sequence.html#t:Seq). The focuslist package is similar to [pointed-list](http://hackage.haskell.org/package/pointedlist-0.6.1) or [list-zipper](http://hackage.haskell.org/package/ListZipper). Focuslist however is optimised for fast indexing and insertion at any point, and can be empty. For operations where linked lists perform better the other packages are likely to be superior, though for other operations focuslist is likely to be faster. ## Example Here is a short example of using `FocusList`. ```haskell module Main where import Data.FocusList ( Focus(Focus), FocusList, appendFL, fromListFL, getFocusItemFL, prependFL , singletonFL ) import Data.Foldable (toList) -- | Create a new 'FocusList' from a list. You must set the 'Focus' of the new -- 'FocusList'. The 'Focus' is counting from zero, so the @goat@ element should -- have the 'Focus'. -- -- If you try to specify a 'Focus' out of range from the input list, -- 'fromListFL' will return 'Nothing'. myFocusList :: Maybe (FocusList String) myFocusList = fromListFL (Focus 2) ["hello", "bye", "goat", "dog"] -- | You can get the focused element from an existing 'FocusList' -- -- If the 'FocusList' is empty, this returns 'Nothing'. myFocusElement :: FocusList String -> Maybe String myFocusElement focuslist = getFocusItemFL focuslist -- | You can append to either side of a 'FocusList'. -- -- 'singletonFL' creates a 'FocusList' with a single element. -- That single element will have the 'Focus'. -- -- 'myFocusListAppended' will have a value of -- @FocusList (Focus 1) ["bye", "hello", "foobar"]@ myFocusListAppended :: FocusList String myFocusListAppended = prependFL "bye" (appendFL (singletonFL "hello") "foobar") -- | 'FocusList' is an instance of 'Functor' and 'Foldable', so you can use -- functions like 'fmap' and 'toList' on a 'FocusList'. fmapAndConvertToList :: FocusList Int -> [String] fmapAndConvertToList focuslist = toList (fmap show focuslist) main :: IO () main = do putStrLn "myFocusList:" print myFocusList putStrLn "\nmyFocusListAppended:" print myFocusListAppended putStrLn "\nmyFocusElement myFocusListAppended:" print (myFocusElement myFocusListAppended) putStrLn "\nfmap length myFocusListAppended:" print (fmap length myFocusListAppended) putStrLn "\nfmapAndConvertToList (fmap length myFocusListAppended):" print (fmapAndConvertToList (fmap length myFocusListAppended)) ``` ## Maintainers - [Grendel-Grendel-Grendel](https://github.com/Grendel-Grendel-Grendel) - [cdepillabout](https://github.com/cdepillabout) focuslist-0.1.1.0/CHANGELOG.md0000644000000000000000000000100714164730112013656 0ustar0000000000000000# Changelog for focuslist ## Unreleased changes ## v0.1.1.0 - Add functions `updateFocusItemFL`, `setFocusItemFL`, and `traversalFocusItem`. [#13](https://github.com/cdepillabout/focuslist/pull/13). ## v0.1.0.2 - Update to allow the latest version of genvalidity ([#8](https://github.com/cdepillabout/focuslist/pull/8)). Thanks [George Wilson](https://github.com/gwils)! - Add some lower version bounds to dependencies. ## v0.1.0.1 - Enables older GHC versions for Travis ## v0.1.0.0 - Initial release.