{-# LANGUAGE AllowAmbiguousTypes    #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs                  #-}
{-# LANGUAGE LambdaCase             #-}
{-# LANGUAGE OverloadedLabels       #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeApplications       #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeInType             #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE UndecidableInstances   #-}


-- |
-- Module      : Data.Mutable.MutBranch
-- Copyright   : (c) Justin Le 2020
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Tools for working with potential branches of piecewise-mutable
-- values.
--
-- If "Data.Mutable.Parts" is for product types, then
-- "Data.Mutable.Branches" is for sum types.
--
-- See <https://mutable.jle.im/06-mutable-branches.html> for an
-- introduction to this module.
module Data.Mutable.Branches (
    MutBranch(..)
  , thawBranch
  , freezeBranch
  , hasBranch, hasn'tBranch
  , moveBranch
  , copyBranch
  , cloneBranch
  , unsafeThawBranch
  , unsafeFreezeBranch
  , withBranch, withBranch_
  , modifyBranch, modifyBranch'
  , updateBranch, updateBranch'
  , modifyBranchM, modifyBranchM'
  , updateBranchM, updateBranchM'
  -- * Built-in 'MutBranch'
  , compMB, idMB
  -- ** Using GHC Generics
  , constrMB, CLabel(..), GMutBranchConstructor, MapRef
  -- ** For common types
  , nilMB, consMB
  , nothingMB, justMB
  , leftMB, rightMB
  ) where

import           Control.Monad
import           Control.Monad.Primitive
import           Data.Generics.Product.Internal.HList
import           Data.Maybe
import           Data.Mutable.Class
import           Data.Mutable.Instances
import           Data.Primitive.MutVar
import           GHC.Generics
import           GHC.OverloadedLabels
import           GHC.TypeLits
import qualified Data.GenericLens.Internal              as GL
import qualified Data.Generics.Internal.Profunctor.Lens as GLP

-- | A @'MutBranch' m s a@ represents the information that @s@ could
-- potentially be an @a@.  Similar in spirit to a @Prism' s a@.
--
-- @'MutBranch' m s a@ means that @a@ is one potential option that @s@
-- could be in, or that @s@ is a sum type and @a@ is one of the
-- branches/constructors.
--
-- See <https://mutable.jle.im/06-mutable-branches.html> for an
-- introduction to this module.
--
-- If 'Data.Mutable.Parts.MutPart' is for product types, then 'MutBranch'
-- is for sum types.
--
-- In this case, "branch" means "potential option".  For example, the
-- branches of 'Either' are 'Left' and 'Right'.
--
-- The simplest way to make these is by using 'constrMB'.  For instance, to
-- get the two branches of an 'Either':
--
-- @
-- constrMB #_Left   :: MutBranch m (Either a b) a
-- constrMB #_Right  :: MutBranch m (Either a b) b
-- @
--
-- @
-- ghci> r <- 'thawRef' (Left 10)
-- ghci> 'freezeBranch' ('constrMB' #_Left) r
-- Just 10
-- ghci> freezeBranch (constrMB #_Right) r
-- Nothing
-- @
--
-- It uses OverloadedLabels, but requires an underscore before the
-- constructor name due to limitations in the extension.
--
-- One nice way to /use/ these is with 'withBranch_':
--
-- @
-- ghci> r <- 'thawRef' (Just 10)
-- ghci> 'withBranch_' (constrMB #_Just) $ \i ->    -- @i@ is an Int ref
--    ..   modifyRef i (+ 1)
-- ghci> 'freezeRef' r
-- Just 11
-- @
--
-- @
-- ghci> r <- thawRef Nothing
-- ghci> withBranch_ (constrMB #_Just) $ \i ->    -- @i@ is an Int ref
--    ..   modifyRef i (+ 1)
-- ghci> freezeRef r
-- Nothing
-- @
--
-- Perhaps the most useful usage of this abstraction is for recursive data
-- types.
--
-- @
-- data List a = Nil | Cons a (List a)
--   deriving Generic
--
-- instance Mutable m a => 'Mutable' m (List a) where
--     type Ref m (List a) = 'GRef' m (List a)
-- @
--
-- @'GRef' m (List a)@ is now a mutable linked list!  Once we make the
-- 'MutBranch' for the nil and cons cases:
--
-- @
-- nilBranch :: MutBranch m (List a) ()
-- nilBranch = constrMB #_Nil
--
-- consBranch :: MutBranch m (List a) (a, List a)
-- consBranch = constrMB #_Cons
-- @
--
--
-- Here is a function to check if a linked list is currently empty:
--
-- @
-- isEmpty
--     :: (PrimMonad m, Mutable m a)
--     => Ref m (List a)
--     -> m Bool
-- isEmpty = hasBranch nilBranch
-- @
--
-- Here is one to "pop" a mutable linked list, giving us the first value
-- and shifting the rest of the list up.
--
-- @
-- popStack
--     :: (PrimMonad m, Mutable m a)
--     => Ref m (List a)
--     -> m (Maybe a)
-- popStack r = do
--     c <- projectBranch consBranch r
--     case c of
--       Nothing      -> pure Nothing
--       Just (x, xs) -> do
--         moveRef r xs
--         Just <$> freezeRef x
-- @
--
-- And here is a function to concatenate a second linked list to the end of a
-- first one.
--
-- @
-- concatLists
--     :: (PrimMonad m, Mutable m a)
--     => Ref m (List a)
--     -> Ref m (List a)
--     -> m ()
-- concatLists l1 l2 = do
--     c <- projectBranch consBranch l1
--     case c of
--       Nothing      -> moveRef l1 l2
--       Just (_, xs) -> concatLists xs l2
-- @
data MutBranch m s a = MutBranch
    { -- | With a 'MutBranch', attempt to get the mutable contents of
      -- a branch of a mutable
      -- @s@, if possible.
      --
      -- @
      -- ghci> r <- thawRef (Left 10)
      -- ghci> s <- projectBranch (constrMB #_Left) r
      -- ghci> case s of Just s' -> freezeRef s'
      -- 10
      -- @
      --
      -- @
      -- ghci> r <- thawRef (Right True)
      -- ghci> s <- projectBranch (constrMB #_Left) r
      -- ghci> case s of Nothing -> "it was Right"
      -- "it was Right"
      -- @
      MutBranch m s a -> Ref m s -> m (Maybe (Ref m a))
projectBranch :: Ref m s -> m (Maybe (Ref m a))
      -- | Embed an @a@ ref as a part of a larger @s@ ref.  Note that this
      -- /does not copy or clone/: any mutations to the @a@ ref will be
      -- reflected in the @s@ ref, as long as the @s@ ref maintains the
      -- reference.
      --
      -- @
      -- ghci> r <- thawRef 100
      -- ghci> s <- embedBranch (constMB #_Left) r
      -- ghci> freezeRef s
      -- Left 100
      -- ghci> modifyRef r (+ 1)
      -- ghci> freezeRef s
      -- Left 101
      -- @
      --
      -- Any mutations on @s@ (as long as they keep the same branch) will
      -- also affect @a@:
      --
      -- @
      -- ghci> copyRef s (Left 0)
      -- ghci> freezeRef r
      -- 0
      -- @
      --
      -- However, "switching branches" on an 'Either' ref will cause it to
      -- loose the original reference:
      --
      -- @
      -- ghci> copyRef s (Right True)
      -- ghci> copyRef s (Left 999)
      -- ghci> freezeRef r
      -- 0
      -- @
    , MutBranch m s a -> Ref m a -> m (Ref m s)
embedBranch :: Ref m a -> m (Ref m s)
    }

-- | Compose two 'MutBranch's, to drill down on what is being focused.
compMB :: Monad m => MutBranch m a b -> MutBranch m b c -> MutBranch m a c
compMB :: MutBranch m a b -> MutBranch m b c -> MutBranch m a c
compMB mb1 :: MutBranch m a b
mb1 mb2 :: MutBranch m b c
mb2 = MutBranch :: forall (m :: * -> *) s a.
(Ref m s -> m (Maybe (Ref m a)))
-> (Ref m a -> m (Ref m s)) -> MutBranch m s a
MutBranch
    { projectBranch :: Ref m a -> m (Maybe (Ref m c))
projectBranch = MutBranch m a b -> Ref m a -> m (Maybe (Ref m b))
forall (m :: * -> *) s a.
MutBranch m s a -> Ref m s -> m (Maybe (Ref m a))
projectBranch MutBranch m a b
mb1 (Ref m a -> m (Maybe (Ref m b)))
-> (Maybe (Ref m b) -> m (Maybe (Ref m c)))
-> Ref m a
-> m (Maybe (Ref m c))
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
        Nothing -> Maybe (Ref m c) -> m (Maybe (Ref m c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Ref m c)
forall a. Maybe a
Nothing
        Just s :: Ref m b
s  -> MutBranch m b c -> Ref m b -> m (Maybe (Ref m c))
forall (m :: * -> *) s a.
MutBranch m s a -> Ref m s -> m (Maybe (Ref m a))
projectBranch MutBranch m b c
mb2 Ref m b
s
    , embedBranch :: Ref m c -> m (Ref m a)
embedBranch = MutBranch m a b -> Ref m b -> m (Ref m a)
forall (m :: * -> *) s a. MutBranch m s a -> Ref m a -> m (Ref m s)
embedBranch MutBranch m a b
mb1 (Ref m b -> m (Ref m a))
-> (Ref m c -> m (Ref m b)) -> Ref m c -> m (Ref m a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< MutBranch m b c -> Ref m c -> m (Ref m b)
forall (m :: * -> *) s a. MutBranch m s a -> Ref m a -> m (Ref m s)
embedBranch MutBranch m b c
mb2
    }

-- | An identity 'MutBranch', treating the item itself as a whole branch.
-- 'cloneBranch' will always "match".
idMB :: Applicative m => MutBranch m a a
idMB :: MutBranch m a a
idMB = (Ref m a -> m (Maybe (Ref m a)))
-> (Ref m a -> m (Ref m a)) -> MutBranch m a a
forall (m :: * -> *) s a.
(Ref m s -> m (Maybe (Ref m a)))
-> (Ref m a -> m (Ref m s)) -> MutBranch m s a
MutBranch (Maybe (Ref m a) -> m (Maybe (Ref m a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Ref m a) -> m (Maybe (Ref m a)))
-> (Ref m a -> Maybe (Ref m a)) -> Ref m a -> m (Maybe (Ref m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> Maybe (Ref m a)
forall a. a -> Maybe a
Just) Ref m a -> m (Ref m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | With a 'MutBranch', thaw an @a@ into a mutable @s@ on that branch.
--
-- @
-- ghci> r <- 'thawBranch' ('constrMB' #_Left) 10
-- ghci> 'freezeRef' r
-- Left 10
-- @
thawBranch
    :: Mutable m a
    => MutBranch m s a
    -> a
    -> m (Ref m s)
thawBranch :: MutBranch m s a -> a -> m (Ref m s)
thawBranch mb :: MutBranch m s a
mb = MutBranch m s a -> Ref m a -> m (Ref m s)
forall (m :: * -> *) s a. MutBranch m s a -> Ref m a -> m (Ref m s)
embedBranch MutBranch m s a
mb (Ref m a -> m (Ref m s)) -> (a -> m (Ref m a)) -> a -> m (Ref m s)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> m (Ref m a)
forall (m :: * -> *) a. Mutable m a => a -> m (Ref m a)
thawRef

-- | With a 'MutBranch', read out a specific @a@ branch of an @s@, if it exists.
--
-- @
-- ghci> r <- 'thawRef' (Left 10)
-- ghci> 'freezeBranch' ('constrMB' #_Left) r
-- Just 10
-- ghci> freezeBranch (constrMB #_Right) r
-- Nothing
-- @
freezeBranch
    :: Mutable m a
    => MutBranch m s a    -- ^ How to check if is @s@ is an @a@
    -> Ref m s            -- ^ Structure to read out of
    -> m (Maybe a)
freezeBranch :: MutBranch m s a -> Ref m s -> m (Maybe a)
freezeBranch mb :: MutBranch m s a
mb = (Ref m a -> m a) -> Maybe (Ref m a) -> m (Maybe a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ref m a -> m a
forall (m :: * -> *) a. Mutable m a => Ref m a -> m a
freezeRef (Maybe (Ref m a) -> m (Maybe a))
-> (Ref m s -> m (Maybe (Ref m a))) -> Ref m s -> m (Maybe a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< MutBranch m s a -> Ref m s -> m (Maybe (Ref m a))
forall (m :: * -> *) s a.
MutBranch m s a -> Ref m s -> m (Maybe (Ref m a))
projectBranch MutBranch m s a
mb

-- | Check if an @s@ is currently a certain branch @a@.
hasBranch
    :: Mutable m a
    => MutBranch m s a
    -> Ref m s
    -> m Bool
hasBranch :: MutBranch m s a -> Ref m s -> m Bool
hasBranch mb :: MutBranch m s a
mb = (Maybe (Ref m a) -> Bool) -> m (Maybe (Ref m a)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Ref m a) -> Bool
forall a. Maybe a -> Bool
isJust (m (Maybe (Ref m a)) -> m Bool)
-> (Ref m s -> m (Maybe (Ref m a))) -> Ref m s -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutBranch m s a -> Ref m s -> m (Maybe (Ref m a))
forall (m :: * -> *) s a.
MutBranch m s a -> Ref m s -> m (Maybe (Ref m a))
projectBranch MutBranch m s a
mb

-- | Check if an @s@ is /not/ currently a certain branch @a@.
hasn'tBranch
    :: Mutable m a
    => MutBranch m s a
    -> Ref m s
    -> m Bool
hasn'tBranch :: MutBranch m s a -> Ref m s -> m Bool
hasn'tBranch mb :: MutBranch m s a
mb = (Maybe (Ref m a) -> Bool) -> m (Maybe (Ref m a)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Ref m a) -> Bool
forall a. Maybe a -> Bool
isNothing (m (Maybe (Ref m a)) -> m Bool)
-> (Ref m s -> m (Maybe (Ref m a))) -> Ref m s -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutBranch m s a -> Ref m s -> m (Maybe (Ref m a))
forall (m :: * -> *) s a.
MutBranch m s a -> Ref m s -> m (Maybe (Ref m a))
projectBranch MutBranch m s a
mb

-- | With a 'MutBranch', /set/ @s@ to have the branch @a@.
--
-- @
-- ghci> r <- 'thawRef' (Left 10)
-- ghci> 'copyBranch' ('constrMB' #_Left) r 5678
-- ghci> 'freezeRef' r
-- Left 5678
-- ghci> copyBranch (constrMB #_Right) r True
-- ghci> freezeRef r
-- Right True
-- @
copyBranch
    :: (Mutable m s, Mutable m a)
    => MutBranch m s a      -- ^ How to check if @s@ is an @a@
    -> Ref m s              -- ^ Structure to write into
    -> a                    -- ^ Value to set @s@ to be
    -> m ()
copyBranch :: MutBranch m s a -> Ref m s -> a -> m ()
copyBranch mb :: MutBranch m s a
mb r :: Ref m s
r = MutBranch m s a -> Ref m s -> Ref m a -> m ()
forall (m :: * -> *) s a.
Mutable m s =>
MutBranch m s a -> Ref m s -> Ref m a -> m ()
moveBranch MutBranch m s a
mb Ref m s
r (Ref m a -> m ()) -> (a -> m (Ref m a)) -> a -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> m (Ref m a)
forall (m :: * -> *) a. Mutable m a => a -> m (Ref m a)
thawRef

-- | With a 'MutBranch', overwrite an @s@ as an @a@, on that branch.
--
-- @
-- ghci> r <- thawRef (Left 10)
-- ghci> s <- thawRef 100
-- ghci> moveBranch (constrMB #_Left) r s
-- ghci> freezeRef r
-- Left 100
-- ghci> t <- thawRef True
-- ghci> moveBranch (constrMB #_Right) r t
-- ghci> freezeRef r
-- Right True
-- @
moveBranch
    :: Mutable m s
    => MutBranch m s a
    -> Ref m s
    -> Ref m a
    -> m ()
moveBranch :: MutBranch m s a -> Ref m s -> Ref m a -> m ()
moveBranch mb :: MutBranch m s a
mb r :: Ref m s
r = Ref m s -> Ref m s -> m ()
forall (m :: * -> *) a. Mutable m a => Ref m a -> Ref m a -> m ()
moveRef Ref m s
r (Ref m s -> m ()) -> (Ref m a -> m (Ref m s)) -> Ref m a -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< MutBranch m s a -> Ref m a -> m (Ref m s)
forall (m :: * -> *) s a. MutBranch m s a -> Ref m a -> m (Ref m s)
embedBranch MutBranch m s a
mb

-- | With a 'MutBranch', attempt to clone out a branch of a mutable
-- @s@, if possible.
--
-- @
-- ghci> r <- thawRef (Left 10)
-- ghci> s <- cloneBranch (constrMB #_Left)
-- ghci> case s of Just s' -> freezeRef s'
-- 10
-- @
--
-- @
-- ghci> r <- thawRef (Right True)
-- ghci> s <- cloneBranch (constrMB #_Left)
-- ghci> case s of Nothing -> "it was Right"
-- "it was Right"
-- @
cloneBranch
    :: Mutable m a
    => MutBranch m s a      -- ^ How to check if @s@ is an @a@
    -> Ref m s              -- ^ Structure to read out of
    -> m (Maybe (Ref m a))
cloneBranch :: MutBranch m s a -> Ref m s -> m (Maybe (Ref m a))
cloneBranch mb :: MutBranch m s a
mb = (Ref m a -> m (Ref m a)) -> Maybe (Ref m a) -> m (Maybe (Ref m a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ref m a -> m (Ref m a)
forall (m :: * -> *) a. Mutable m a => Ref m a -> m (Ref m a)
cloneRef (Maybe (Ref m a) -> m (Maybe (Ref m a)))
-> (Ref m s -> m (Maybe (Ref m a)))
-> Ref m s
-> m (Maybe (Ref m a))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< MutBranch m s a -> Ref m s -> m (Maybe (Ref m a))
forall (m :: * -> *) s a.
MutBranch m s a -> Ref m s -> m (Maybe (Ref m a))
projectBranch MutBranch m s a
mb

-- | A non-copying version of 'freezeBranch' that can be more efficient
-- for types where the mutable representation is the same as the immutable
-- one (like 'V.Vector').
--
-- This is safe as long as you never again modify the mutable
-- reference, since it can potentially directly mutate the frozen value
-- magically.
unsafeFreezeBranch
    :: Mutable m a
    => MutBranch m s a    -- ^ How to check if is @s@ is an @a@
    -> Ref m s            -- ^ Structure to read out of
    -> m (Maybe a)
unsafeFreezeBranch :: MutBranch m s a -> Ref m s -> m (Maybe a)
unsafeFreezeBranch mb :: MutBranch m s a
mb = (Ref m a -> m a) -> Maybe (Ref m a) -> m (Maybe a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ref m a -> m a
forall (m :: * -> *) a. Mutable m a => Ref m a -> m a
unsafeFreezeRef (Maybe (Ref m a) -> m (Maybe a))
-> (Ref m s -> m (Maybe (Ref m a))) -> Ref m s -> m (Maybe a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< MutBranch m s a -> Ref m s -> m (Maybe (Ref m a))
forall (m :: * -> *) s a.
MutBranch m s a -> Ref m s -> m (Maybe (Ref m a))
projectBranch MutBranch m s a
mb

-- | A non-copying version of 'thawBranch' that can be more efficient for
-- types where the mutable representation is the same as the immutable one
-- (like 'V.Vector').
--
-- This is safe as long as you never again use the original pure value,
-- since it can potentially directly mutate it.
unsafeThawBranch
    :: Mutable m a
    => MutBranch m s a
    -> a
    -> m (Ref m s)
unsafeThawBranch :: MutBranch m s a -> a -> m (Ref m s)
unsafeThawBranch mb :: MutBranch m s a
mb = MutBranch m s a -> Ref m a -> m (Ref m s)
forall (m :: * -> *) s a. MutBranch m s a -> Ref m a -> m (Ref m s)
embedBranch MutBranch m s a
mb (Ref m a -> m (Ref m s)) -> (a -> m (Ref m a)) -> a -> m (Ref m s)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> m (Ref m a)
forall (m :: * -> *) a. Mutable m a => a -> m (Ref m a)
unsafeThawRef


-- | With a 'MutBranch', if an @s@ is on the @a@ branch, perform an action
-- on the @a@ reference and overwrite the @s@ with the modified @a@.
-- Returns the result of the action, if @a@ was found.
--
-- @
-- ghci> r <- 'thawRef' (Just 10)
-- ghci> 'withBranch_' ('constrMB' #_Just) $ \i ->    -- @i@ is an Int ref
--    ..   'modifyRef' i (+ 1)
-- ghci> 'freezeRef' r
-- Just 11
-- @
--
-- @
-- ghci> r <- thawRef Nothing
-- ghci> withBranch_ (constrMB #_Just) $ \i ->    -- @i@ is an Int ref
--    ..   modifyRef i (+ 1)
-- ghci> freezeRef r
-- Nothing
-- @
withBranch
    :: Mutable m a
    => MutBranch m s a    -- ^ How to check if is @s@ is an @a@
    -> Ref m s            -- ^ Structure to read out of and write into
    -> (Ref m a -> m b)   -- ^ Action to perform on the @a@ branch of @s@
    -> m (Maybe b)
withBranch :: MutBranch m s a -> Ref m s -> (Ref m a -> m b) -> m (Maybe b)
withBranch mb :: MutBranch m s a
mb r :: Ref m s
r f :: Ref m a -> m b
f = (Ref m a -> m b) -> Maybe (Ref m a) -> m (Maybe b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ref m a -> m b
f (Maybe (Ref m a) -> m (Maybe b))
-> m (Maybe (Ref m a)) -> m (Maybe b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MutBranch m s a -> Ref m s -> m (Maybe (Ref m a))
forall (m :: * -> *) s a.
MutBranch m s a -> Ref m s -> m (Maybe (Ref m a))
projectBranch MutBranch m s a
mb Ref m s
r

-- | 'withBranch', but discarding the returned value.
withBranch_
    :: Mutable m a
    => MutBranch m s a    -- ^ How to check if is @s@ is an @a@
    -> Ref m s            -- ^ Structure to read out of and write into
    -> (Ref m a -> m b)   -- ^ Action to perform on the @a@ branch of @s@
    -> m ()
withBranch_ :: MutBranch m s a -> Ref m s -> (Ref m a -> m b) -> m ()
withBranch_ mb :: MutBranch m s a
mb r :: Ref m s
r = m (Maybe b) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe b) -> m ())
-> ((Ref m a -> m b) -> m (Maybe b)) -> (Ref m a -> m b) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutBranch m s a -> Ref m s -> (Ref m a -> m b) -> m (Maybe b)
forall (m :: * -> *) a s b.
Mutable m a =>
MutBranch m s a -> Ref m s -> (Ref m a -> m b) -> m (Maybe b)
withBranch MutBranch m s a
mb Ref m s
r

-- | With a 'MutBranch', run a pure function over a potential branch @a@ of
-- @s@.  If @s@ is not on that branch, leaves @s@ unchanged.
--
-- @
-- ghci> r <- 'thawRef' (Just 10)
-- ghci> 'modifyBranch' ('constrMB' #_Just) r (+ 1)
-- ghci> freezeRef r
-- Just 11
-- @
--
-- @
-- ghci> r <- thawRef Nothing
-- ghci> modifyBranch (constrMB #_Just) r (+ 1)
-- ghci> freezeRef r
-- Nothing
-- @
modifyBranch
    :: Mutable m a
    => MutBranch m s a      -- ^ How to check if @s@ is an @a@
    -> Ref m s            -- ^ Structure to read out of and write into
    -> (a -> a)             -- ^ Pure function modifying @a@
    -> m ()
modifyBranch :: MutBranch m s a -> Ref m s -> (a -> a) -> m ()
modifyBranch mb :: MutBranch m s a
mb r :: Ref m s
r f :: a -> a
f = MutBranch m s a -> Ref m s -> (Ref m a -> m ()) -> m ()
forall (m :: * -> *) a s b.
Mutable m a =>
MutBranch m s a -> Ref m s -> (Ref m a -> m b) -> m ()
withBranch_ MutBranch m s a
mb Ref m s
r (Ref m a -> (a -> a) -> m ()
forall (m :: * -> *) a. Mutable m a => Ref m a -> (a -> a) -> m ()
`modifyRef` a -> a
f)

-- | 'modifyBranch', but forces the result before storing it back in the
-- reference.
modifyBranch'
    :: Mutable m a
    => MutBranch m s a      -- ^ How to check if @s@ is an @a@
    -> Ref m s            -- ^ Structure to read out of and write into
    -> (a -> a)             -- ^ Pure function modifying @a@
    -> m ()
modifyBranch' :: MutBranch m s a -> Ref m s -> (a -> a) -> m ()
modifyBranch' mb :: MutBranch m s a
mb r :: Ref m s
r f :: a -> a
f = MutBranch m s a -> Ref m s -> (Ref m a -> m ()) -> m ()
forall (m :: * -> *) a s b.
Mutable m a =>
MutBranch m s a -> Ref m s -> (Ref m a -> m b) -> m ()
withBranch_ MutBranch m s a
mb Ref m s
r (Ref m a -> (a -> a) -> m ()
forall (m :: * -> *) a. Mutable m a => Ref m a -> (a -> a) -> m ()
`modifyRef'` a -> a
f)

-- | 'modifyBranch' but for a monadic function.  Uses 'copyRef' into the
-- reference after the action is completed.
modifyBranchM
    :: Mutable m a
    => MutBranch m s a      -- ^ How to check if @s@ is an @a@
    -> Ref m s            -- ^ Structure to read out of and write into
    -> (a -> m a)             -- ^ Monadic function modifying @a@
    -> m ()
modifyBranchM :: MutBranch m s a -> Ref m s -> (a -> m a) -> m ()
modifyBranchM mb :: MutBranch m s a
mb r :: Ref m s
r f :: a -> m a
f = MutBranch m s a -> Ref m s -> (Ref m a -> m ()) -> m ()
forall (m :: * -> *) a s b.
Mutable m a =>
MutBranch m s a -> Ref m s -> (Ref m a -> m b) -> m ()
withBranch_ MutBranch m s a
mb Ref m s
r (Ref m a -> (a -> m a) -> m ()
forall (m :: * -> *) a.
Mutable m a =>
Ref m a -> (a -> m a) -> m ()
`modifyRefM` a -> m a
f)

-- | 'modifyBranchM', but forces the result before storing it back in the
-- reference.
modifyBranchM'
    :: Mutable m a
    => MutBranch m s a      -- ^ How to check if @s@ is an @a@
    -> Ref m s            -- ^ Structure to read out of and write into
    -> (a -> m a)             -- ^ Monadic function modifying @a@
    -> m ()
modifyBranchM' :: MutBranch m s a -> Ref m s -> (a -> m a) -> m ()
modifyBranchM' mb :: MutBranch m s a
mb r :: Ref m s
r f :: a -> m a
f = MutBranch m s a -> Ref m s -> (Ref m a -> m ()) -> m ()
forall (m :: * -> *) a s b.
Mutable m a =>
MutBranch m s a -> Ref m s -> (Ref m a -> m b) -> m ()
withBranch_ MutBranch m s a
mb Ref m s
r (Ref m a -> (a -> m a) -> m ()
forall (m :: * -> *) a.
Mutable m a =>
Ref m a -> (a -> m a) -> m ()
`modifyRefM'` a -> m a
f)

-- | With a 'MutBranch', run a pure function over a potential branch @a@ of
-- @s@.  The function returns the updated @a@ and also an output value to
-- observe.  If @s@ is not on that branch, leaves @s@ unchanged.
--
-- @
-- ghci> r <- 'thawRef' (Just 10)
-- ghci> 'updateBranch' ('constrMB' #_Just) r $ \i -> (i + 1, show i)
-- Just "10"
-- ghci> 'freezeRef' r
-- Just 11
-- @
--
-- @
-- ghci> r <- thawRef Nothing
-- ghci> updateBranch (constrMB #_Just) r $ \i -> (i + 1, show i)
-- Nothing
-- ghci> freezeRef r
-- Nothing
-- @
updateBranch
    :: Mutable m a
    => MutBranch m s a      -- ^ How to check if @s@ is an @a@
    -> Ref m s            -- ^ Structure to read out of and write into
    -> (a -> (a, b))
    -> m (Maybe b)
updateBranch :: MutBranch m s a -> Ref m s -> (a -> (a, b)) -> m (Maybe b)
updateBranch mb :: MutBranch m s a
mb r :: Ref m s
r f :: a -> (a, b)
f = MutBranch m s a -> Ref m s -> (Ref m a -> m b) -> m (Maybe b)
forall (m :: * -> *) a s b.
Mutable m a =>
MutBranch m s a -> Ref m s -> (Ref m a -> m b) -> m (Maybe b)
withBranch MutBranch m s a
mb Ref m s
r (Ref m a -> (a -> (a, b)) -> m b
forall (m :: * -> *) a b.
Mutable m a =>
Ref m a -> (a -> (a, b)) -> m b
`updateRef` a -> (a, b)
f)

-- | 'updateBranch', but forces the result before storing it back in the
-- reference.
updateBranch'
    :: Mutable m a
    => MutBranch m s a      -- ^ How to check if @s@ is an @a@
    -> Ref m s            -- ^ Structure to read out of and write into
    -> (a -> (a, b))
    -> m (Maybe b)
updateBranch' :: MutBranch m s a -> Ref m s -> (a -> (a, b)) -> m (Maybe b)
updateBranch' mb :: MutBranch m s a
mb r :: Ref m s
r f :: a -> (a, b)
f = MutBranch m s a -> Ref m s -> (Ref m a -> m b) -> m (Maybe b)
forall (m :: * -> *) a s b.
Mutable m a =>
MutBranch m s a -> Ref m s -> (Ref m a -> m b) -> m (Maybe b)
withBranch MutBranch m s a
mb Ref m s
r (Ref m a -> (a -> (a, b)) -> m b
forall (m :: * -> *) a b.
Mutable m a =>
Ref m a -> (a -> (a, b)) -> m b
`updateRef'` a -> (a, b)
f)

-- | 'updateBranch' but for a monadic function.  Uses 'copyRef' into the
-- reference after the action is completed.
updateBranchM
    :: Mutable m a
    => MutBranch m s a      -- ^ How to check if @s@ is an @a@
    -> Ref m s            -- ^ Structure to read out of and write into
    -> (a -> m (a, b))
    -> m (Maybe b)
updateBranchM :: MutBranch m s a -> Ref m s -> (a -> m (a, b)) -> m (Maybe b)
updateBranchM mb :: MutBranch m s a
mb r :: Ref m s
r f :: a -> m (a, b)
f = MutBranch m s a -> Ref m s -> (Ref m a -> m b) -> m (Maybe b)
forall (m :: * -> *) a s b.
Mutable m a =>
MutBranch m s a -> Ref m s -> (Ref m a -> m b) -> m (Maybe b)
withBranch MutBranch m s a
mb Ref m s
r (Ref m a -> (a -> m (a, b)) -> m b
forall (m :: * -> *) a b.
Mutable m a =>
Ref m a -> (a -> m (a, b)) -> m b
`updateRefM` a -> m (a, b)
f)

-- | 'updateBranchM', but forces the result before storing it back in the
-- reference.
updateBranchM'
    :: Mutable m a
    => MutBranch m s a      -- ^ How to check if @s@ is an @a@
    -> Ref m s            -- ^ Structure to read out of and write into
    -> (a -> m (a, b))
    -> m (Maybe b)
updateBranchM' :: MutBranch m s a -> Ref m s -> (a -> m (a, b)) -> m (Maybe b)
updateBranchM' mb :: MutBranch m s a
mb r :: Ref m s
r f :: a -> m (a, b)
f = MutBranch m s a -> Ref m s -> (Ref m a -> m b) -> m (Maybe b)
forall (m :: * -> *) a s b.
Mutable m a =>
MutBranch m s a -> Ref m s -> (Ref m a -> m b) -> m (Maybe b)
withBranch MutBranch m s a
mb Ref m s
r (Ref m a -> (a -> m (a, b)) -> m b
forall (m :: * -> *) a b.
Mutable m a =>
Ref m a -> (a -> m (a, b)) -> m b
`updateRefM'` a -> m (a, b)
f)



-- | A version of 'Data.Vinyl.Derived.Label' that removes an underscore at
-- the beginning when used with -XOverloadedLabels.  Used to specify
-- constructors, since labels are currently not able to start with capital
-- letters.
data CLabel (ctor :: Symbol) = CLabel

instance (ctor_ ~ AppendSymbol "_" ctor) => IsLabel ctor_ (CLabel ctor) where
    fromLabel :: CLabel ctor
fromLabel = CLabel ctor
forall (ctor :: Symbol). CLabel ctor
CLabel



-- | Typeclass powering 'constrMB' using GHC Generics.
--
-- Heavily inspired by "Data.Generics.Sum.Constructors".
class (GMutable m f, Mutable m a) => GMutBranchConstructor (ctor :: Symbol) m f a | ctor f -> a where
    gmbcProj  :: CLabel ctor -> GRef_ m f x -> m (Maybe (Ref m a))
    gmbcEmbed :: CLabel ctor -> Ref m a -> m (GRef_ m f x)

instance
      ( GMutable m f
      , Mutable m a
      , GIsList (GRef_ m f) (GRef_ m f) (MapRef m as) (MapRef m as)
      , GIsList f f as as
      , ListTuple a a as as
      , ListTuple b b (MapRef m as) (MapRef m as)
      , Ref m a ~ b
      )
      => GMutBranchConstructor ctor m (M1 C ('MetaCons ctor fixity fields) f) a where
    gmbcProj :: CLabel ctor
-> GRef_ m (M1 C ('MetaCons ctor fixity fields) f) x
-> m (Maybe (Ref m a))
gmbcProj _  = Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe b -> m (Maybe b))
-> (M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x -> Maybe b)
-> M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x
-> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe b
forall a. a -> Maybe a
Just
                (b -> Maybe b)
-> (M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x -> b)
-> M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x
-> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListTuple b b (MapRef m as) (MapRef m as) =>
HList (MapRef m as) -> b
forall tuple tuple' (as :: [*]) (bs :: [*]).
ListTuple tuple tuple' as bs =>
HList as -> tuple
listToTuple @b @b @(MapRef m as) @(MapRef m as)
                (HList (MapRef m as) -> b)
-> (M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x
    -> HList (MapRef m as))
-> M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens
  (GRef_ m f x)
  (GRef_ m f x)
  (HList (MapRef m as))
  (HList (MapRef m as))
-> GRef_ m f x -> HList (MapRef m as)
forall s a. Lens s s a a -> s -> a
GLP.view forall (f :: * -> *) (g :: * -> *) (as :: [*]) (bs :: [*]) x.
GIsList f g as bs =>
Iso (f x) (g x) (HList as) (HList bs)
Lens
  (GRef_ m f x)
  (GRef_ m f x)
  (HList (MapRef m as))
  (HList (MapRef m as))
glist (GRef_ m f x -> HList (MapRef m as))
-> (M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x
    -> GRef_ m f x)
-> M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x
-> HList (MapRef m as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x -> GRef_ m f x
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
    gmbcEmbed :: CLabel ctor
-> Ref m a -> m (GRef_ m (M1 C ('MetaCons ctor fixity fields) f) x)
gmbcEmbed _ = M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x
-> m (M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x
 -> m (M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x))
-> (b -> M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x)
-> b
-> m (M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GRef_ m f x -> M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (GRef_ m f x -> M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x)
-> (b -> GRef_ m f x)
-> b
-> M1 C ('MetaCons ctor fixity fields) (GRef_ m f) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens
  (HList (MapRef m as))
  (HList (MapRef m as))
  (GRef_ m f x)
  (GRef_ m f x)
-> HList (MapRef m as) -> GRef_ m f x
forall s a. Lens s s a a -> s -> a
GLP.view (Iso
  (GRef_ m f x)
  (GRef_ m f x)
  (HList (MapRef m as))
  (HList (MapRef m as))
-> Iso
     (HList (MapRef m as))
     (HList (MapRef m as))
     (GRef_ m f x)
     (GRef_ m f x)
forall s t a b. Iso s t a b -> Iso b a t s
GL.fromIso forall (f :: * -> *) (g :: * -> *) (as :: [*]) (bs :: [*]) x.
GIsList f g as bs =>
Iso (f x) (g x) (HList as) (HList bs)
Iso
  (GRef_ m f x)
  (GRef_ m f x)
  (HList (MapRef m as))
  (HList (MapRef m as))
glist)
                (HList (MapRef m as) -> GRef_ m f x)
-> (b -> HList (MapRef m as)) -> b -> GRef_ m f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (bs :: [*]). ListTuple b b (MapRef m as) bs => b -> HList bs
forall tuple tuple' (as :: [*]) (bs :: [*]).
ListTuple tuple tuple' as bs =>
tuple' -> HList bs
tupleToList @b @_ @(MapRef m as)

instance GMutBranchConstructor ctor m f a => GMutBranchConstructor ctor m (M1 D meta f) a where
    gmbcProj :: CLabel ctor -> GRef_ m (M1 D meta f) x -> m (Maybe (Ref m a))
gmbcProj  lb :: CLabel ctor
lb = CLabel ctor -> GRef_ m f x -> m (Maybe (Ref m a))
forall k (ctor :: Symbol) (m :: * -> *) (f :: k -> *) a (x :: k).
GMutBranchConstructor ctor m f a =>
CLabel ctor -> GRef_ m f x -> m (Maybe (Ref m a))
gmbcProj CLabel ctor
lb (GRef_ m f x -> m (Maybe (Ref m a)))
-> (M1 D meta (GRef_ m f) x -> GRef_ m f x)
-> M1 D meta (GRef_ m f) x
-> m (Maybe (Ref m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 D meta (GRef_ m f) x -> GRef_ m f x
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
    gmbcEmbed :: CLabel ctor -> Ref m a -> m (GRef_ m (M1 D meta f) x)
gmbcEmbed lb :: CLabel ctor
lb = (GRef_ m f x -> M1 D meta (GRef_ m f) x)
-> m (GRef_ m f x) -> m (M1 D meta (GRef_ m f) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GRef_ m f x -> M1 D meta (GRef_ m f) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (m (GRef_ m f x) -> m (M1 D meta (GRef_ m f) x))
-> (Ref m a -> m (GRef_ m f x))
-> Ref m a
-> m (M1 D meta (GRef_ m f) x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLabel ctor -> Ref m a -> m (GRef_ m f x)
forall k (ctor :: Symbol) (m :: * -> *) (f :: k -> *) a (x :: k).
GMutBranchConstructor ctor m f a =>
CLabel ctor -> Ref m a -> m (GRef_ m f x)
gmbcEmbed CLabel ctor
lb

instance
      ( PrimMonad m
      , Mutable m a
      , GMutBranchSum ctor (GL.HasCtorP ctor l) m l r a
      )
      => GMutBranchConstructor ctor m (l :+: r) a where
    gmbcProj :: CLabel ctor -> GRef_ m (l :+: r) x -> m (Maybe (Ref m a))
gmbcProj  = forall k (ctor :: Symbol) (contains :: Bool) (m :: * -> *)
       (l :: k -> *) (r :: k -> *) a (x :: k).
GMutBranchSum ctor contains m l r a =>
CLabel ctor
-> MutSumF m (GRef_ m l) (GRef_ m r) x -> m (Maybe (Ref m a))
forall (m :: * -> *) (l :: k -> *) (r :: k -> *) a (x :: k).
GMutBranchSum ctor (HasCtorP ctor l) m l r a =>
CLabel ctor
-> MutSumF m (GRef_ m l) (GRef_ m r) x -> m (Maybe (Ref m a))
gmbsProj @ctor @(GL.HasCtorP ctor l)
    gmbcEmbed :: CLabel ctor -> Ref m a -> m (GRef_ m (l :+: r) x)
gmbcEmbed = forall k (ctor :: Symbol) (contains :: Bool) (m :: * -> *)
       (l :: k -> *) (r :: k -> *) a (x :: k).
GMutBranchSum ctor contains m l r a =>
CLabel ctor -> Ref m a -> m (MutSumF m (GRef_ m l) (GRef_ m r) x)
forall (m :: * -> *) (l :: k -> *) (r :: k -> *) a (x :: k).
GMutBranchSum ctor (HasCtorP ctor l) m l r a =>
CLabel ctor -> Ref m a -> m (MutSumF m (GRef_ m l) (GRef_ m r) x)
gmbsEmbed @ctor @(GL.HasCtorP ctor l)

class (GMutable m l, GMutable m r, Mutable m a) => GMutBranchSum (ctor :: Symbol) (contains :: Bool) m l r a | ctor l r -> a where
    gmbsProj  :: CLabel ctor -> MutSumF m (GRef_ m l) (GRef_ m r) x -> m (Maybe (Ref m a))
    gmbsEmbed :: CLabel ctor -> Ref m a -> m (MutSumF m (GRef_ m l) (GRef_ m r) x)

instance
      ( PrimMonad m
      , GMutable m r
      , GMutBranchConstructor ctor m l a
      , GIsList (GRef_ m l) (GRef_ m l) (MapRef m as) (MapRef m as)
      , GIsList l l as as
      , ListTuple a a as as
      , ListTuple b b (MapRef m as) (MapRef m as)
      , Ref m a ~ b
      )
      => GMutBranchSum ctor 'True m l r a where
    gmbsProj :: CLabel ctor
-> MutSumF m (GRef_ m l) (GRef_ m r) x -> m (Maybe (Ref m a))
gmbsProj lb :: CLabel ctor
lb (MutSumF r :: MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x)
r) = MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x)
-> m ((:+:) (GRef_ m l) (GRef_ m r) x)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x)
r m ((:+:) (GRef_ m l) (GRef_ m r) x)
-> ((:+:) (GRef_ m l) (GRef_ m r) x -> m (Maybe b)) -> m (Maybe b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      L1 x :: GRef_ m l x
x -> CLabel ctor -> GRef_ m l x -> m (Maybe (Ref m a))
forall k (ctor :: Symbol) (m :: * -> *) (f :: k -> *) a (x :: k).
GMutBranchConstructor ctor m f a =>
CLabel ctor -> GRef_ m f x -> m (Maybe (Ref m a))
gmbcProj CLabel ctor
lb GRef_ m l x
x
      R1 _ -> Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
    gmbsEmbed :: CLabel ctor -> Ref m a -> m (MutSumF m (GRef_ m l) (GRef_ m r) x)
gmbsEmbed _ = (MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x)
 -> MutSumF m (GRef_ m l) (GRef_ m r) x)
-> m (MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x))
-> m (MutSumF m (GRef_ m l) (GRef_ m r) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x)
-> MutSumF m (GRef_ m l) (GRef_ m r) x
forall k (m :: * -> *) (f :: k -> *) (g :: k -> *) (a :: k).
MutVar (PrimState m) ((:+:) f g a) -> MutSumF m f g a
MutSumF (m (MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x))
 -> m (MutSumF m (GRef_ m l) (GRef_ m r) x))
-> (b
    -> m (MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x)))
-> b
-> m (MutSumF m (GRef_ m l) (GRef_ m r) x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:+:) (GRef_ m l) (GRef_ m r) x
-> m (MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar ((:+:) (GRef_ m l) (GRef_ m r) x
 -> m (MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x)))
-> (b -> (:+:) (GRef_ m l) (GRef_ m r) x)
-> b
-> m (MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GRef_ m l x -> (:+:) (GRef_ m l) (GRef_ m r) x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (GRef_ m l x -> (:+:) (GRef_ m l) (GRef_ m r) x)
-> (b -> GRef_ m l x) -> b -> (:+:) (GRef_ m l) (GRef_ m r) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens
  (HList (MapRef m as))
  (HList (MapRef m as))
  (GRef_ m l x)
  (GRef_ m l x)
-> HList (MapRef m as) -> GRef_ m l x
forall s a. Lens s s a a -> s -> a
GLP.view (Iso
  (GRef_ m l x)
  (GRef_ m l x)
  (HList (MapRef m as))
  (HList (MapRef m as))
-> Iso
     (HList (MapRef m as))
     (HList (MapRef m as))
     (GRef_ m l x)
     (GRef_ m l x)
forall s t a b. Iso s t a b -> Iso b a t s
GL.fromIso forall (f :: * -> *) (g :: * -> *) (as :: [*]) (bs :: [*]) x.
GIsList f g as bs =>
Iso (f x) (g x) (HList as) (HList bs)
Iso
  (GRef_ m l x)
  (GRef_ m l x)
  (HList (MapRef m as))
  (HList (MapRef m as))
glist)
                (HList (MapRef m as) -> GRef_ m l x)
-> (b -> HList (MapRef m as)) -> b -> GRef_ m l x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (bs :: [*]). ListTuple b b (MapRef m as) bs => b -> HList bs
forall tuple tuple' (as :: [*]) (bs :: [*]).
ListTuple tuple tuple' as bs =>
tuple' -> HList bs
tupleToList @b @_ @(MapRef m as)

instance
      ( PrimMonad m
      , GMutable m l
      , GMutBranchConstructor ctor m r a
      , GIsList (GRef_ m r) (GRef_ m r) (MapRef m as) (MapRef m as)
      , GIsList r r as as
      , ListTuple a a as as
      , ListTuple b b (MapRef m as) (MapRef m as)
      , Ref m a ~ b
      )
      => GMutBranchSum ctor 'False m l r a where
    gmbsProj :: CLabel ctor
-> MutSumF m (GRef_ m l) (GRef_ m r) x -> m (Maybe (Ref m a))
gmbsProj lb :: CLabel ctor
lb (MutSumF r :: MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x)
r) = MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x)
-> m ((:+:) (GRef_ m l) (GRef_ m r) x)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x)
r m ((:+:) (GRef_ m l) (GRef_ m r) x)
-> ((:+:) (GRef_ m l) (GRef_ m r) x -> m (Maybe b)) -> m (Maybe b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      L1 _ -> Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
      R1 x :: GRef_ m r x
x -> CLabel ctor -> GRef_ m r x -> m (Maybe (Ref m a))
forall k (ctor :: Symbol) (m :: * -> *) (f :: k -> *) a (x :: k).
GMutBranchConstructor ctor m f a =>
CLabel ctor -> GRef_ m f x -> m (Maybe (Ref m a))
gmbcProj CLabel ctor
lb GRef_ m r x
x
    gmbsEmbed :: CLabel ctor -> Ref m a -> m (MutSumF m (GRef_ m l) (GRef_ m r) x)
gmbsEmbed _ = (MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x)
 -> MutSumF m (GRef_ m l) (GRef_ m r) x)
-> m (MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x))
-> m (MutSumF m (GRef_ m l) (GRef_ m r) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x)
-> MutSumF m (GRef_ m l) (GRef_ m r) x
forall k (m :: * -> *) (f :: k -> *) (g :: k -> *) (a :: k).
MutVar (PrimState m) ((:+:) f g a) -> MutSumF m f g a
MutSumF (m (MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x))
 -> m (MutSumF m (GRef_ m l) (GRef_ m r) x))
-> (b
    -> m (MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x)))
-> b
-> m (MutSumF m (GRef_ m l) (GRef_ m r) x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:+:) (GRef_ m l) (GRef_ m r) x
-> m (MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar ((:+:) (GRef_ m l) (GRef_ m r) x
 -> m (MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x)))
-> (b -> (:+:) (GRef_ m l) (GRef_ m r) x)
-> b
-> m (MutVar (PrimState m) ((:+:) (GRef_ m l) (GRef_ m r) x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GRef_ m r x -> (:+:) (GRef_ m l) (GRef_ m r) x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (GRef_ m r x -> (:+:) (GRef_ m l) (GRef_ m r) x)
-> (b -> GRef_ m r x) -> b -> (:+:) (GRef_ m l) (GRef_ m r) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens
  (HList (MapRef m as))
  (HList (MapRef m as))
  (GRef_ m r x)
  (GRef_ m r x)
-> HList (MapRef m as) -> GRef_ m r x
forall s a. Lens s s a a -> s -> a
GLP.view (Iso
  (GRef_ m r x)
  (GRef_ m r x)
  (HList (MapRef m as))
  (HList (MapRef m as))
-> Iso
     (HList (MapRef m as))
     (HList (MapRef m as))
     (GRef_ m r x)
     (GRef_ m r x)
forall s t a b. Iso s t a b -> Iso b a t s
GL.fromIso forall (f :: * -> *) (g :: * -> *) (as :: [*]) (bs :: [*]) x.
GIsList f g as bs =>
Iso (f x) (g x) (HList as) (HList bs)
Iso
  (GRef_ m r x)
  (GRef_ m r x)
  (HList (MapRef m as))
  (HList (MapRef m as))
glist)
                (HList (MapRef m as) -> GRef_ m r x)
-> (b -> HList (MapRef m as)) -> b -> GRef_ m r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (bs :: [*]). ListTuple b b (MapRef m as) bs => b -> HList bs
forall tuple tuple' (as :: [*]) (bs :: [*]).
ListTuple tuple tuple' as bs =>
tuple' -> HList bs
tupleToList @b @_ @(MapRef m as)

-- | Create a 'MutBranch' for any data type with a 'Generic' instance by
-- specifying the constructor name using OverloadedLabels
--
-- @
-- ghci> r <- 'thawRef' (Left 10)
-- ghci> 'freezeBranch' ('constrMB' #_Left) r
-- Just 10
-- ghci> freezeBranch (constrMB #_Right) r
-- Nothing
-- @
--
-- Note that due to limitations in OverloadedLabels, you must prefix the
-- constructor name with an undescore.
--
-- There also isn't currently any way to utilize OverloadedLabels with
-- operator identifiers, so using it with operator constructors (like @:@
-- and @[]@) requires explicit TypeApplications:
--
-- @
-- -- | 'MutBranch' focusing on the cons case of a list
-- consMB :: (PrimMonad m, Mutable m a) => MutBranch m [a] (a, [a])
-- consMB = 'constrMB' ('CLabel' @":")
-- @
constrMB
    :: forall ctor m s a.
     ( Ref m s ~ GRef m s
     , GMutBranchConstructor ctor m (Rep s) a
     )
    => CLabel ctor
    -> MutBranch m s a
constrMB :: CLabel ctor -> MutBranch m s a
constrMB l :: CLabel ctor
l = MutBranch :: forall (m :: * -> *) s a.
(Ref m s -> m (Maybe (Ref m a)))
-> (Ref m a -> m (Ref m s)) -> MutBranch m s a
MutBranch
    { projectBranch :: Ref m s -> m (Maybe (Ref m a))
projectBranch = CLabel ctor -> GRef_ m (Rep s) () -> m (Maybe (Ref m a))
forall k (ctor :: Symbol) (m :: * -> *) (f :: k -> *) a (x :: k).
GMutBranchConstructor ctor m f a =>
CLabel ctor -> GRef_ m f x -> m (Maybe (Ref m a))
gmbcProj CLabel ctor
l (GRef_ m (Rep s) () -> m (Maybe (Ref m a)))
-> (GRef m s -> GRef_ m (Rep s) ())
-> GRef m s
-> m (Maybe (Ref m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GRef m s -> GRef_ m (Rep s) ()
forall (m :: * -> *) a. GRef m a -> GRef_ m (Rep a) ()
unGRef
    , embedBranch :: Ref m a -> m (Ref m s)
embedBranch   = (GRef_ m (Rep s) () -> GRef m s)
-> m (GRef_ m (Rep s) ()) -> m (GRef m s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GRef_ m (Rep s) () -> GRef m s
forall (m :: * -> *) a. GRef_ m (Rep a) () -> GRef m a
GRef (m (GRef_ m (Rep s) ()) -> m (GRef m s))
-> (Ref m a -> m (GRef_ m (Rep s) ())) -> Ref m a -> m (GRef m s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLabel ctor -> Ref m a -> m (GRef_ m (Rep s) ())
forall k (ctor :: Symbol) (m :: * -> *) (f :: k -> *) a (x :: k).
GMutBranchConstructor ctor m f a =>
CLabel ctor -> Ref m a -> m (GRef_ m f x)
gmbcEmbed CLabel ctor
l
    }

-- | 'MutBranch' focusing on the nil case of a list
nilMB :: (PrimMonad m, Mutable m a) => MutBranch m [a] ()
nilMB :: MutBranch m [a] ()
nilMB = CLabel "[]" -> MutBranch m [a] ()
forall (ctor :: Symbol) (m :: * -> *) s a.
(Ref m s ~ GRef m s, GMutBranchConstructor ctor m (Rep s) a) =>
CLabel ctor -> MutBranch m s a
constrMB (CLabel "[]"
forall (ctor :: Symbol). CLabel ctor
CLabel @"[]")

-- | 'MutBranch' focusing on the cons case of a list
consMB :: (PrimMonad m, Mutable m a) => MutBranch m [a] (a, [a])
consMB :: MutBranch m [a] (a, [a])
consMB = CLabel ":" -> MutBranch m [a] (a, [a])
forall (ctor :: Symbol) (m :: * -> *) s a.
(Ref m s ~ GRef m s, GMutBranchConstructor ctor m (Rep s) a) =>
CLabel ctor -> MutBranch m s a
constrMB (CLabel ":"
forall (ctor :: Symbol). CLabel ctor
CLabel @":")

-- | 'MutBranch' focusing on the 'Nothing' case of a 'Maybe'
nothingMB :: (PrimMonad m, Mutable m a) => MutBranch m (Maybe a) ()
nothingMB :: MutBranch m (Maybe a) ()
nothingMB = CLabel "Nothing" -> MutBranch m (Maybe a) ()
forall (ctor :: Symbol) (m :: * -> *) s a.
(Ref m s ~ GRef m s, GMutBranchConstructor ctor m (Rep s) a) =>
CLabel ctor -> MutBranch m s a
constrMB IsLabel "_Nothing" (CLabel "Nothing")
CLabel "Nothing"
#_Nothing

-- | 'MutBranch' focusing on the 'Just' case of a 'Maybe'
justMB :: (PrimMonad m, Mutable m a) => MutBranch m (Maybe a) a
justMB :: MutBranch m (Maybe a) a
justMB = CLabel "Just" -> MutBranch m (Maybe a) a
forall (ctor :: Symbol) (m :: * -> *) s a.
(Ref m s ~ GRef m s, GMutBranchConstructor ctor m (Rep s) a) =>
CLabel ctor -> MutBranch m s a
constrMB IsLabel "_Just" (CLabel "Just")
CLabel "Just"
#_Just

-- | 'MutBranch' focusing on the 'Left' case of an 'Either'
leftMB :: (PrimMonad m, Mutable m a, Mutable m b) => MutBranch m (Either a b) a
leftMB :: MutBranch m (Either a b) a
leftMB = CLabel "Left" -> MutBranch m (Either a b) a
forall (ctor :: Symbol) (m :: * -> *) s a.
(Ref m s ~ GRef m s, GMutBranchConstructor ctor m (Rep s) a) =>
CLabel ctor -> MutBranch m s a
constrMB IsLabel "_Left" (CLabel "Left")
CLabel "Left"
#_Left

-- | 'MutBranch' focusing on the 'Right' case of an 'Either'
rightMB :: (PrimMonad m, Mutable m a, Mutable m b) => MutBranch m (Either a b) b
rightMB :: MutBranch m (Either a b) b
rightMB = CLabel "Right" -> MutBranch m (Either a b) b
forall (ctor :: Symbol) (m :: * -> *) s a.
(Ref m s ~ GRef m s, GMutBranchConstructor ctor m (Rep s) a) =>
CLabel ctor -> MutBranch m s a
constrMB IsLabel "_Right" (CLabel "Right")
CLabel "Right"
#_Right