focuslist (empty) → 0.1.0.0

raw patch · 11 files changed

+1750/−0 lines, 11 filesdep +QuickCheckdep +basedep +containersbuild-type:Customsetup-changed

Dependencies added: QuickCheck, base, containers, doctest, focuslist, genvalidity-containers, genvalidity-hspec, hedgehog, lens, markdown-unlit, mono-traversable, tasty, tasty-hedgehog, tasty-hspec, template-haskell

Files

CHANGELOG.md +7/−0
LICENSE +30/−0
README.md +79/−0
Setup.hs +40/−0
focuslist.cabal +103/−0
src/Data/FocusList.hs +1207/−0
test/DocTest.hs +12/−0
test/Test.hs +20/−0
test/Test/FocusList.hs +44/−0
test/Test/FocusList/Invariants.hs +129/−0
test/readme/README.lhs +79/−0

+ CHANGELOG.md view

@@ -0,0 +1,7 @@+# Changelog for focuslist++## Unreleased changes++## v0.1.0.0++- Initial release.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright 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.

+ README.md view

@@ -0,0 +1,79 @@+FocusList+=========++[![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).++## 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)

+ Setup.hs view

@@ -0,0 +1,40 @@+-- 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.cabal view

@@ -0,0 +1,103 @@+name:                focuslist+version:             0.1.0.0+synopsis:            Lists with a focused element+description:         Please see <https://github.com/cdepillabout/focuslist#readme README.md>.+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.7 && < 5+                     , containers+                     , lens+                     , mono-traversable+                     , QuickCheck+  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-containers+                     , genvalidity-hspec+                     , hedgehog+                     , lens+                     , QuickCheck+                     , tasty+                     , tasty-hedgehog+                     , tasty-hspec+  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+

+ src/Data/FocusList.hs view

@@ -0,0 +1,1207 @@+{-# 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+    -- *** 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', (^.), (.~), (-~), 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+  )+import Text.Show (Show(showsPrec), ShowS, showParen, showString)++-- $setup+-- >>> :set -XFlexibleContexts+-- >>> :set -XScopedTypeVariables+-- >>> import Data.Maybe (isJust)++-- | 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.+_Focus :: Prism' Focus Int+_Focus = prism' Focus (foldFocus Nothing Just)++-- | A 'Prism'' for focusing on the 'NoFocus' constructor in a 'Focus' data type.+_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+ )++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++-- | 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))

+ test/DocTest.hs view

@@ -0,0 +1,12 @@++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

+ test/Test.hs view

@@ -0,0 +1,20 @@++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+      ]

+ test/Test/FocusList.hs view

@@ -0,0 +1,44 @@+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Test.FocusList where++import Data.GenValidity.Sequence ()+import Test.QuickCheck (Gen)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.Hedgehog (testProperty)+import Test.Tasty.Hspec (Spec, 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 => GenValid (FocusList a) where+  genValid :: Gen (FocusList a)+  genValid = genValidFL genValid++instance GenInvalid 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)

+ test/Test/FocusList/Invariants.hs view

@@ -0,0 +1,129 @@++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

+ test/readme/README.lhs view

@@ -0,0 +1,79 @@+FocusList+=========++[![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).++## 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)