Selectable

Selectable.hs

{-# language DeriveFunctor #-}
{-# language DeriveFoldable #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language UndecidableInstances #-}
{-# language StandaloneDeriving #-}
module Data.Functor.Selectable where

import Control.Arrow ((&&&))
import Control.Comonad
import Data.Bifunctor
import Data.Bitraversable
import Data.Bifoldable

newtype Selection f b a = Selection
  { unwrapSelection :: f (Either b a)
  } deriving (Functor, Foldable)

deriving instance (Eq (f (Either b a))) => Eq (Selection f b a)
deriving instance (Show (f (Either b a))) => Show (Selection f b a)

instance (Functor f) => Bifunctor (Selection f) where
  first f = Selection . fmap (first f) . unwrapSelection
  second = fmap

instance (Foldable f) => Bifoldable (Selection f) where
  bifoldMap l r = foldMap (bifoldMap l r) . unwrapSelection

instance (Traversable f) => Bitraversable (Selection f) where
  bitraverse l r = fmap Selection . traverse (bitraverse l r) . unwrapSelection

embed :: (Functor f) => f a -> Selection f a a
embed = Selection . fmap Right

choose' :: (a -> b) -> (a -> Bool) -> a -> Either b b
choose' f p a = if p a then Right (f a)
                      else Left (f a)

choose :: (a -> Bool) -> a -> Either a a
choose = choose' id

switch :: Either a b -> Either b a
switch = either Right Left

selectWithContext :: Comonad w => (w a -> Bool) -> Selection w a a -> Selection w a a
selectWithContext f = Selection . extend (choose' extract f) . clear

clear :: Functor f => Selection f a a -> f a
clear = fmap (either id id) . unwrapSelection

select :: Functor f => (a -> Bool) -> Selection f a a -> Selection f a a
select f = Selection . fmap (choose f) . clear

include :: Functor f => (a -> Bool) -> Selection f a a -> Selection f a a
include f = Selection . fmap (either (choose f) Right) . unwrapSelection

exclude :: Functor f => (a -> Bool) -> Selection f a a -> Selection f a a
exclude f = Selection . fmap (either Left (switch . choose f)) . unwrapSelection

selectAll :: (Functor f) => Selection f a a -> Selection f a a
selectAll = select (const True)

unselectAll :: (Functor f) => Selection f a a -> Selection f a a
unselectAll = select (const False)

invertSelection :: Functor f => Selection f b a -> Selection f a b
invertSelection = Selection . fmap switch . unwrapSelection

mapSelected :: Functor f => (a -> c) -> Selection f b a -> Selection f b c
mapSelected = fmap

mapUnselected :: Functor f => (b -> c) -> Selection f b a -> Selection f c a
mapUnselected = first

getSelected :: Foldable f => Selection f b a -> [a]
getSelected = foldMap (:[])

getUnselected :: (Functor f, Foldable f) => Selection f b a -> [b]
getUnselected = foldMap (:[]) . invertSelection

-- Examples
-- λ> embed [1..6] & select even & fmap (+10) & clear
-- [1,12,3,14,5,16]
-- λ> embed [1..6] & select even & fmap (+10) & getSelected
-- [12,14,16]
-- λ> embed [1..6] & select (>3) & include (==1) & exclude (==5) & getSelected
-- [1,4,6]