nikita-volkov/focus

A general abstraction for manipulating elements of container data structures

focus's Issues

Nothing -> Keep/Remove

Hi, just curious - do you know of any examples where a Strategy is passed Nothing, but the library wants to interpret Keep and Remove differently?

It seems to me that when given Nothing, Keep/Remove become synonyms, as there is no focused element.

If so, should this be prevented by the library? The first solution that comes to mind (and it's not a very good one) is:

data Found s a where
  Found :: a -> Found s a -- like Just
  Missing :: Found False a -- like Nothing

data Decision s a where
  Keep :: Decision s a
  Remove :: Decision True a
  Replace :: a -> Decision s a

Thus, Missing -> Remove is revented by True ~ False being unsatisfiable, but all other combinations type check.

Missing example

This package is missing an example

Hackage revision

focus-1.0.3.1 does not build with GHC-9.8.X. This is fixed in focus-1.0.3.2.

@Bodigrim can you make a revision restricting base < 4.19 in focus-1.0.3.1?

$ cabal build -w ghc-9.8
Resolving dependencies...
Build profile: -w ghc-9.8.1 -O1
In order, the following will be built (use -v for more details):
 - focus-1.0.3.1 (lib) (first run)
Configuring library for focus-1.0.3.1..
Preprocessing library for focus-1.0.3.1..
Building library for focus-1.0.3.1..
[1 of 2] Compiling Focus.Prelude    ( library/Focus/Prelude.hs, /home/hasufell/tmp/focus-1.0.3.1/dist-newstyle/build/x86_64-linux/ghc-9.8.1/focus-1.0.3.1/build/Focus/Prelude.o, /home/hasufell/tmp/focus-1.0.3.1/dist-newstyle/build/x86_64-linux/ghc-9.8.1/focus-1.0.3.1/build/Focus/Prelude.dyn_o )

library/Focus/Prelude.hs:2:5: error: [GHC-69158]
    Conflicting exports for ‘unzip’:
       ‘module Exports’ exports ‘Exports.unzip’
         imported from ‘Data.Functor’ at library/Focus/Prelude.hs:33:1-30
       ‘module Exports’ exports ‘Exports.unzip’
         imported from ‘Prelude’ at library/Focus/Prelude.hs:74:1-191
         (and originally defined in ‘GHC.List’)
  |
2 |   ( module Exports,
  |     ^^^^^^^^^^^^^^
Error: cabal: Failed to build focus-1.0.3.1.

Can't remove the element using update

Function update leaves the element instead of removing it when the passed function returns Nothing.

Based on nikita-volkov/stm-containers#28.

"delete" issue

It does not seem to be fixed in 1.0.1.4 (either in focus or stm-containers / hamt). The code below loops infinitely:

#!/usr/bin/env stack
{- stack
  script
  --resolver lts-16.26
  --package stm
  --package async
  --package focus
  --package transformers
  --package hashable
  --package unsafe
  --package containers
  --package nonempty-containers
  --package stm-containers
  --extra-dep stm-hamt-1.2.0.4@sha256:7957497c022554b7599e790696d1a3e56359ad99e5da36a251894c626ca1f60a,3970
  --extra-dep primitive-extras-0.8@sha256:fca0310150496867f5b9421fe1541ecda87fae17eae44885a29f9c52dd00c8ff,2963
  --extra-dep primitive-unlifted-0.1.3.0@sha256:a98f827740f5dcf097d885b3a47c32f4462204449620abc9d51b8c4f8619f9e6,1427
-}

import           Control.Concurrent
import           Control.Concurrent.STM
import           Control.Monad
import           Data.Hashable          (Hashable)
import           Data.Maybe
import qualified Data.Sequence          as S
import           Data.Sequence.NonEmpty (NESeq, (|>))
import qualified Data.Sequence.NonEmpty as NES
import qualified Focus                  as F
import qualified StmContainers.Map      as SM
import           System.IO.Unsafe
import           System.Unsafe

popQueue :: (Hashable k, Eq k) => k -> SM.Map k (NESeq v) -> IO (Maybe v)
popQueue key queue = atomically $ do
  element'm <- SM.focus popQueueF key queue
  when (isNothing element'm) $ SM.delete key queue -- this doesn't delete either!!!
  pure element'm
  where
    popQueueF = do
      element'm <- fmap (fmap NES.head) F.lookup
      queue'm <- fmap (join . (fmap (NES.nonEmptySeq . NES.tail))) F.lookup
      unsafePerformIO $ do -- debugging
        let elem_ = coerce element'm :: Maybe (String)
        let elem_t = coerce queue'm :: Maybe (NESeq String)
        putStrLn "***"
        putStrLn $ show $ elem_
        putStrLn $ show $ elem_t
        putStrLn "***"
        threadDelay 100000
        pure F.lookup
      -- F.alter (join . fmap (NES.nonEmptySeq . NES.tail))
      case queue'm of
        Just queue_ -> F.insert queue_
        Nothing     -> F.delete -- doesn't delete!!!
      pure element'm

pushQueue :: (Hashable k, Eq k) => k -> v -> SM.Map k (NESeq v) -> IO ()
pushQueue key value = atomically . SM.focus pushQueueF key
  where
    pushQueueF = F.insertOrMerge (<>) (NES.singleton value)


main :: IO ()
main = do
  putStrLn "\n"
  queue <- SM.newIO :: IO (SM.Map Int (NESeq String))
  pushQueue 1 "foo" queue
  pushQueue 1 "bar" queue
  pushQueue 2 "fooz" queue
  pushQueue 2 "baz" queue
  putStrLn $ "DRAIN-----1"
  drainQ 1 queue putStrLn
  putStrLn $ "DRAIN-----2"
  drainQ 2 queue putStrLn
    where
      drainQ :: (Hashable k, Eq k) => k -> SM.Map k (NESeq v) -> (v -> IO a) -> IO ()
      drainQ key queue act = do
        element'm <- popQueue key queue
        case element'm of
          Just element -> do act element
                             drainQ key queue act
          Nothing -> pure ()

Originally posted by @carbolymer in #5 (comment)

The semantics of Focus.alter don't match those of Data.Map.alter

I have a map of nonempty sets:

import Data.Map
import Data.Set.NonEmpty

m :: Map a (NESet b)
m = mempty 

-- | Remove (a, b) association, if it exists. If this results in an empty set for key a, then remove it.
rm :: a -> b -> Map a (NESet b) -> Map a (NESet b)
rm a b = Map.alter (NESet.nonEmptySet . NESet.delete b =<<) a

The same does not work for stm-containers and focus:

import StmContainers.Map
import Data.Set.NonEmpty
import Focus

-- | If this results in an empty set for key a, _the original singleton set is left untouched_.
rm :: a -> b -> Map a (NESet b) -> STM ()
rm a b = 
  let f = Focus.alter (NESet.nonEmptySet . NESet.delete b =<<)
  in Map.focus f a 

-- example

ex :: IO ()
ex = do
  m <- Map.newIO
  atomically $ Map.insert (NESet.singleton 1) "key" m 
  atomically $ rm "key" 1 m
  isEmpty <- atomically $ Map.null m
  assert $ isEmpty -- fails!