{-|
Module      : MList
Description : Mutable linked lists in STT
Copyright   : (c) John Maraist, 2022
License     : AllRightsReserved
Maintainer  : haskell-tms@maraist.org
Stability   : experimental
Portability : POSIX

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
implied, for NON-COMMERCIAL use.  See the License for the specific
language governing permissions and limitations under the License.

-}

{-# LANGUAGE RankNTypes #-}

module Data.TMS.MList where

import Control.Monad.State
import Control.Monad.ST.Trans
import Control.Monad.Except
import Control.Monad.Extra

-- * Mutable lists (cons cells) in `STT`

-- |Singly linked lists!  But with mutable CARs and CDRs à la Common
-- Lisp.
data MList s a = MCons (STRef s a) (STRef s (MList s a))
                 -- ^ A @cons@ cell with mutable fields.
               | MNil
                 -- ^ Regular old @nil@.

-- |Convert a pure list into a mutable list.
toMList :: Monad m => [a] -> STT s m (MList s a)
toMList :: [a] -> STT s m (MList s a)
toMList [] = MList s a -> STT s m (MList s a)
forall (m :: * -> *) a. Monad m => a -> m a
return MList s a
forall s a. MList s a
MNil
toMList (a
x : [a]
xs) = do
  STRef s a
car <- a -> STT s m (STRef s a)
forall (m :: * -> *) a s. Applicative m => a -> STT s m (STRef s a)
newSTRef a
x
  MList s a
cdrBody <- [a] -> STT s m (MList s a)
forall (m :: * -> *) a s. Monad m => [a] -> STT s m (MList s a)
toMList [a]
xs
  STRef s (MList s a)
cdr <- MList s a -> STT s m (STRef s (MList s a))
forall (m :: * -> *) a s. Applicative m => a -> STT s m (STRef s a)
newSTRef MList s a
cdrBody
  MList s a -> STT s m (MList s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList s a -> STT s m (MList s a))
-> MList s a -> STT s m (MList s a)
forall a b. (a -> b) -> a -> b
$ STRef s a -> STRef s (MList s a) -> MList s a
forall s a. STRef s a -> STRef s (MList s a) -> MList s a
MCons STRef s a
car STRef s (MList s a)
cdr

-- |Convert an `MList` to a `String`.
showM :: (Show a, Monad m) => MList s a -> STT s m String
showM :: MList s a -> STT s m String
showM MList s a
MNil = String -> STT s m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"[]"
showM (MCons STRef s a
xr STRef s (MList s a)
xsr) = do
  a
x <- STRef s a -> STT s m a
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s a
xr
  MList s a
xs <- STRef s (MList s a) -> STT s m (MList s a)
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s (MList s a)
xsr
  let sx :: String
sx = a -> String
forall a. Show a => a -> String
show a
x
  String
sxs <- MList s a -> STT s m String
forall a (m :: * -> *) s.
(Show a, Monad m) =>
MList s a -> STT s m String
showM MList s a
xs
  String -> STT s m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> STT s m String) -> String -> STT s m String
forall a b. (a -> b) -> a -> b
$ String
sx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" m: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sxs

-- |Returns `True` for an empty list.
mnull :: MList s a -> Bool
mnull MList s a
MNil = Bool
True
mnull MList s a
_ = Bool
False

-- |Returns `True` from an `STT` monad for a reference to an empty
-- list.
getMnull :: Monad m => STRef s (MList s a) -> STT s m Bool
getMnull :: STRef s (MList s a) -> STT s m Bool
getMnull STRef s (MList s a)
ref = STRef s (MList s a) -> STT s m (MList s a)
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s (MList s a)
ref STT s m (MList s a) -> (MList s a -> STT s m Bool) -> STT s m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> STT s m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> STT s m Bool)
-> (MList s a -> Bool) -> MList s a -> STT s m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MList s a -> Bool
forall s a. MList s a -> Bool
mnull

-- |Returns the CAR (element) of the first CONS cell of a non-empty
-- mutable list.
mcar :: MList s a -> STT s m a
mcar (MCons STRef s a
x STRef s (MList s a)
_)  = STRef s a -> STT s m a
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s a
x
-- |Returns the CDR (next cell) of the first CONS cell of a non-empty
-- mutable list.
mcdr :: MList s a -> STT s m (MList s a)
mcdr (MCons STRef s a
_ STRef s (MList s a)
xs) = STRef s (MList s a) -> STT s m (MList s a)
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s (MList s a)
xs

-- |Convert a traditional Haskell list into a mutable `MList` list.
mlength :: Monad m => MList s a -> STT s m Int
mlength :: MList s a -> STT s m Int
mlength MList s a
MNil = Int -> STT s m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
mlength (MCons STRef s a
_ STRef s (MList s a)
xs) = do
  MList s a
cdr <- STRef s (MList s a) -> STT s m (MList s a)
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s (MList s a)
xs
  Int
cdrLen <- MList s a -> STT s m Int
forall (m :: * -> *) s a. Monad m => MList s a -> STT s m Int
mlength MList s a
cdr
  Int -> STT s m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> STT s m Int) -> Int -> STT s m Int
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cdrLen

-- |Convert a traditional Haskell list into a mutable `MList` list.
fromList :: Monad m => [a] -> STT s m (MList s a)
fromList :: [a] -> STT s m (MList s a)
fromList [] = MList s a -> STT s m (MList s a)
forall (m :: * -> *) a. Monad m => a -> m a
return MList s a
forall s a. MList s a
MNil
fromList (a
x : [a]
xs) = do
  STRef s a
car <- a -> STT s m (STRef s a)
forall (m :: * -> *) a s. Applicative m => a -> STT s m (STRef s a)
newSTRef a
x
  MList s a
tail <- [a] -> STT s m (MList s a)
forall (m :: * -> *) a s. Monad m => [a] -> STT s m (MList s a)
fromList [a]
xs
  STRef s (MList s a)
cdr <- MList s a -> STT s m (STRef s (MList s a))
forall (m :: * -> *) a s. Applicative m => a -> STT s m (STRef s a)
newSTRef MList s a
tail
  MList s a -> STT s m (MList s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList s a -> STT s m (MList s a))
-> MList s a -> STT s m (MList s a)
forall a b. (a -> b) -> a -> b
$ STRef s a -> STRef s (MList s a) -> MList s a
forall s a. STRef s a -> STRef s (MList s a) -> MList s a
MCons STRef s a
car STRef s (MList s a)
cdr

-- |Convert a traditional Haskell list into a mutable `MList` list,
-- applying the given function to each element.
fromListMap :: Monad m => (a -> b) -> [a] -> STT s m (MList s b)
fromListMap :: (a -> b) -> [a] -> STT s m (MList s b)
fromListMap a -> b
_ [] = MList s b -> STT s m (MList s b)
forall (m :: * -> *) a. Monad m => a -> m a
return MList s b
forall s a. MList s a
MNil
fromListMap a -> b
f (a
x : [a]
xs) = do
  STRef s b
car <- b -> STT s m (STRef s b)
forall (m :: * -> *) a s. Applicative m => a -> STT s m (STRef s a)
newSTRef (b -> STT s m (STRef s b)) -> b -> STT s m (STRef s b)
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
  MList s b
tail <- (a -> b) -> [a] -> STT s m (MList s b)
forall (m :: * -> *) a b s.
Monad m =>
(a -> b) -> [a] -> STT s m (MList s b)
fromListMap a -> b
f [a]
xs
  STRef s (MList s b)
cdr <- MList s b -> STT s m (STRef s (MList s b))
forall (m :: * -> *) a s. Applicative m => a -> STT s m (STRef s a)
newSTRef MList s b
tail
  MList s b -> STT s m (MList s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList s b -> STT s m (MList s b))
-> MList s b -> STT s m (MList s b)
forall a b. (a -> b) -> a -> b
$ STRef s b -> STRef s (MList s b) -> MList s b
forall s a. STRef s a -> STRef s (MList s a) -> MList s a
MCons STRef s b
car STRef s (MList s b)
cdr

-- |Convert a mutable `MList` list into a traditional Haskell list.
toList :: Monad m => MList s a -> STT s m [a]
toList :: MList s a -> STT s m [a]
toList MList s a
MNil = [a] -> STT s m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
toList (MCons STRef s a
car STRef s (MList s a)
cdr) = do
  a
x <- STRef s a -> STT s m a
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s a
car
  MList s a
ms <- STRef s (MList s a) -> STT s m (MList s a)
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s (MList s a)
cdr
  [a]
xs <- MList s a -> STT s m [a]
forall (m :: * -> *) s a. Monad m => MList s a -> STT s m [a]
toList MList s a
ms
  [a] -> STT s m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> STT s m [a]) -> [a] -> STT s m [a]
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs

-- |Convert a mutable `MList` list of `Maybe` values into a
-- traditional Haskell list containing only the values under a `Just`
-- constructor.
toUnmaybeList :: Monad m => MList s (Maybe a) -> STT s m [a]
toUnmaybeList :: MList s (Maybe a) -> STT s m [a]
toUnmaybeList MList s (Maybe a)
MNil = [a] -> STT s m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
toUnmaybeList (MCons STRef s (Maybe a)
car STRef s (MList s (Maybe a))
cdr) = do
  Maybe a
xmaybe <- STRef s (Maybe a) -> STT s m (Maybe a)
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s (Maybe a)
car
  MList s (Maybe a)
ms <- STRef s (MList s (Maybe a)) -> STT s m (MList s (Maybe a))
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s (MList s (Maybe a))
cdr
  [a]
xs <- MList s (Maybe a) -> STT s m [a]
forall (m :: * -> *) s a.
Monad m =>
MList s (Maybe a) -> STT s m [a]
toUnmaybeList MList s (Maybe a)
ms
  case Maybe a
xmaybe of
    Maybe a
Nothing -> [a] -> STT s m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs
    Just a
x -> [a] -> STT s m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> STT s m [a]) -> [a] -> STT s m [a]
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs

-- |A version of @map@ for `MList`s.
mlistMap :: Monad m => (a -> b) -> MList s a -> STT s m (MList s b)
mlistMap :: (a -> b) -> MList s a -> STT s m (MList s b)
mlistMap a -> b
f MList s a
MNil = MList s b -> STT s m (MList s b)
forall (m :: * -> *) a. Monad m => a -> m a
return MList s b
forall s a. MList s a
MNil
mlistMap a -> b
f (MCons STRef s a
xref STRef s (MList s a)
xsref) = do
  a
x <- STRef s a -> STT s m a
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s a
xref
  MList s a
xs <- STRef s (MList s a) -> STT s m (MList s a)
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s (MList s a)
xsref
  STRef s b
xref' <- b -> STT s m (STRef s b)
forall (m :: * -> *) a s. Applicative m => a -> STT s m (STRef s a)
newSTRef (b -> STT s m (STRef s b)) -> b -> STT s m (STRef s b)
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
  MList s b
xs' <- (a -> b) -> MList s a -> STT s m (MList s b)
forall (m :: * -> *) a b s.
Monad m =>
(a -> b) -> MList s a -> STT s m (MList s b)
mlistMap a -> b
f MList s a
xs
  STRef s (MList s b)
xsref' <- MList s b -> STT s m (STRef s (MList s b))
forall (m :: * -> *) a s. Applicative m => a -> STT s m (STRef s a)
newSTRef MList s b
xs'
  MList s b -> STT s m (MList s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList s b -> STT s m (MList s b))
-> MList s b -> STT s m (MList s b)
forall a b. (a -> b) -> a -> b
$ STRef s b -> STRef s (MList s b) -> MList s b
forall s a. STRef s a -> STRef s (MList s a) -> MList s a
MCons STRef s b
xref' STRef s (MList s b)
xsref'

-- |A version of @filter@ for `MList`s.
mlistFilter :: Monad m => (a -> Bool) -> MList s a -> STT s m (MList s a)
mlistFilter :: (a -> Bool) -> MList s a -> STT s m (MList s a)
mlistFilter a -> Bool
p MList s a
l = do
  (Bool
_, MList s a
result) <- (a -> Bool) -> MList s a -> STT s m (Bool, MList s a)
forall (m :: * -> *) a s.
Monad m =>
(a -> Bool) -> MList s a -> STT s m (Bool, MList s a)
flt a -> Bool
p MList s a
l
  MList s a -> STT s m (MList s a)
forall (m :: * -> *) a. Monad m => a -> m a
return MList s a
result
  where
    flt :: Monad m => (a -> Bool) -> MList s a -> STT s m (Bool, MList s a)
    flt :: (a -> Bool) -> MList s a -> STT s m (Bool, MList s a)
flt a -> Bool
pred l :: MList s a
l@MList s a
MNil = (Bool, MList s a) -> STT s m (Bool, MList s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, MList s a
l)
    flt a -> Bool
pred l :: MList s a
l@(MCons STRef s a
xref STRef s (MList s a)
xsref) = do
      a
x <- STRef s a -> STT s m a
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s a
xref
      MList s a
xs <- STRef s (MList s a) -> STT s m (MList s a)
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s (MList s a)
xsref
      (Bool
changed, MList s a
xs') <- (a -> Bool) -> MList s a -> STT s m (Bool, MList s a)
forall (m :: * -> *) a s.
Monad m =>
(a -> Bool) -> MList s a -> STT s m (Bool, MList s a)
flt a -> Bool
pred MList s a
xs
      if a -> Bool
pred a
x
      then if Bool
changed
           then do
             STRef s (MList s a)
xsref' <- MList s a -> STT s m (STRef s (MList s a))
forall (m :: * -> *) a s. Applicative m => a -> STT s m (STRef s a)
newSTRef MList s a
xs'
             (Bool, MList s a) -> STT s m (Bool, MList s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, STRef s a -> STRef s (MList s a) -> MList s a
forall s a. STRef s a -> STRef s (MList s a) -> MList s a
MCons STRef s a
xref STRef s (MList s a)
xsref')
           else (Bool, MList s a) -> STT s m (Bool, MList s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, MList s a
l)
      else (Bool, MList s a) -> STT s m (Bool, MList s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, MList s a
xs')

-- |Return a new `MList` which strips off the `Just` constructor from
-- its elements, dropping and elements which are `Nothing`.
mlistUnmaybe :: Monad m => MList s (Maybe a) -> STT s m (MList s a)
mlistUnmaybe :: MList s (Maybe a) -> STT s m (MList s a)
mlistUnmaybe MList s (Maybe a)
MNil = MList s a -> STT s m (MList s a)
forall (m :: * -> *) a. Monad m => a -> m a
return MList s a
forall s a. MList s a
MNil
mlistUnmaybe (MCons STRef s (Maybe a)
xref STRef s (MList s (Maybe a))
xsref) = do
  Maybe a
x <- STRef s (Maybe a) -> STT s m (Maybe a)
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s (Maybe a)
xref
  MList s (Maybe a)
xs <- STRef s (MList s (Maybe a)) -> STT s m (MList s (Maybe a))
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s (MList s (Maybe a))
xsref
  MList s a
xs' <- MList s (Maybe a) -> STT s m (MList s a)
forall (m :: * -> *) s a.
Monad m =>
MList s (Maybe a) -> STT s m (MList s a)
mlistUnmaybe MList s (Maybe a)
xs
  case Maybe a
x of
    Maybe a
Nothing -> MList s a -> STT s m (MList s a)
forall (m :: * -> *) a. Monad m => a -> m a
return MList s a
xs'
    Just a
x' -> do
      STRef s a
xref' <- a -> STT s m (STRef s a)
forall (m :: * -> *) a s. Applicative m => a -> STT s m (STRef s a)
newSTRef a
x'
      STRef s (MList s a)
xsref' <- MList s a -> STT s m (STRef s (MList s a))
forall (m :: * -> *) a s. Applicative m => a -> STT s m (STRef s a)
newSTRef MList s a
xs'
      MList s a -> STT s m (MList s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList s a -> STT s m (MList s a))
-> MList s a -> STT s m (MList s a)
forall a b. (a -> b) -> a -> b
$ STRef s a -> STRef s (MList s a) -> MList s a
forall s a. STRef s a -> STRef s (MList s a) -> MList s a
MCons STRef s a
xref' STRef s (MList s a)
xsref'

-- |Return a new `MList` which drops elements which are `Nothing`.
mlistStripNothing :: Monad m => MList s (Maybe a) -> STT s m (MList s (Maybe a))
mlistStripNothing :: MList s (Maybe a) -> STT s m (MList s (Maybe a))
mlistStripNothing = (Maybe a -> Bool)
-> MList s (Maybe a) -> STT s m (MList s (Maybe a))
forall (m :: * -> *) a s.
Monad m =>
(a -> Bool) -> MList s a -> STT s m (MList s a)
mlistFilter (Bool -> Bool
not (Bool -> Bool) -> (Maybe a -> Bool) -> Maybe a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)

-- |Return a new `MList` which drops elements which are `Nothing` from
-- the `MList` under the reference argument.
getMlistStripNothing ::
  Monad m => STRef s (MList s (Maybe a)) -> STT s m (MList s (Maybe a))
getMlistStripNothing :: STRef s (MList s (Maybe a)) -> STT s m (MList s (Maybe a))
getMlistStripNothing STRef s (MList s (Maybe a))
ref = do
  MList s (Maybe a)
mlist <- STRef s (MList s (Maybe a)) -> STT s m (MList s (Maybe a))
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s (MList s (Maybe a))
ref
  (Maybe a -> Bool)
-> MList s (Maybe a) -> STT s m (MList s (Maybe a))
forall (m :: * -> *) a s.
Monad m =>
(a -> Bool) -> MList s a -> STT s m (MList s a)
mlistFilter (Bool -> Bool
not (Bool -> Bool) -> (Maybe a -> Bool) -> Maybe a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) MList s (Maybe a)
mlist

-- |Treating an `MList` as a stack, add a new element at the top of
-- the stack, and return the new stack top.
mlistPush :: Monad m => a -> MList s a -> STT s m (MList s a)
mlistPush :: a -> MList s a -> STT s m (MList s a)
mlistPush a
item MList s a
mlist = do
  STRef s a
itemRef <- a -> STT s m (STRef s a)
forall (m :: * -> *) a s. Applicative m => a -> STT s m (STRef s a)
newSTRef a
item
  STRef s (MList s a)
mlistRef <- MList s a -> STT s m (STRef s (MList s a))
forall (m :: * -> *) a s. Applicative m => a -> STT s m (STRef s a)
newSTRef MList s a
mlist
  MList s a -> STT s m (MList s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MList s a -> STT s m (MList s a))
-> MList s a -> STT s m (MList s a)
forall a b. (a -> b) -> a -> b
$ STRef s a -> STRef s (MList s a) -> MList s a
forall s a. STRef s a -> STRef s (MList s a) -> MList s a
MCons STRef s a
itemRef STRef s (MList s a)
mlistRef

-- |Treating an `MList` as a stack, add a new element at the top of
-- the stack, and return the new stack top.
mlistRefPush :: Monad m => a -> STRef s (MList s a) -> STT s m ()
mlistRefPush :: a -> STRef s (MList s a) -> STT s m ()
mlistRefPush a
item STRef s (MList s a)
mlistRef = do
  STRef s a
carRef <- a -> STT s m (STRef s a)
forall (m :: * -> *) a s. Applicative m => a -> STT s m (STRef s a)
newSTRef a
item
  MList s a
cdr <- STRef s (MList s a) -> STT s m (MList s a)
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s (MList s a)
mlistRef
  STRef s (MList s a)
newCdrRef <- MList s a -> STT s m (STRef s (MList s a))
forall (m :: * -> *) a s. Applicative m => a -> STT s m (STRef s a)
newSTRef MList s a
cdr
  let newCons :: MList s a
newCons = STRef s a -> STRef s (MList s a) -> MList s a
forall s a. STRef s a -> STRef s (MList s a) -> MList s a
MCons STRef s a
carRef STRef s (MList s a)
newCdrRef
  STRef s (MList s a) -> MList s a -> STT s m ()
forall (m :: * -> *) s a.
Applicative m =>
STRef s a -> a -> STT s m ()
writeSTRef STRef s (MList s a)
mlistRef MList s a
newCons

-- |Iterate over the elements of a `MList`.  The body does not
-- necessarily need operate in the same monad as where the references
-- originate; the @lifter@ parameter brings the latter into the
-- former.
mlistFor_ :: (Monad m0, Monad m) =>
  (forall r . STT s m0 r -> m r) -> MList s a -> (a -> m ()) -> m ()
mlistFor_ :: (forall r. STT s m0 r -> m r) -> MList s a -> (a -> m ()) -> m ()
mlistFor_ forall r. STT s m0 r -> m r
lifter MList s a
MNil a -> m ()
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mlistFor_ forall r. STT s m0 r -> m r
lifter (MCons STRef s a
xref STRef s (MList s a)
xsref) a -> m ()
bodyf = do
  a
x <- STT s m0 a -> m a
forall r. STT s m0 r -> m r
lifter (STT s m0 a -> m a) -> STT s m0 a -> m a
forall a b. (a -> b) -> a -> b
$ STRef s a -> STT s m0 a
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s a
xref
  a -> m ()
bodyf a
x
  MList s a
xs <- STT s m0 (MList s a) -> m (MList s a)
forall r. STT s m0 r -> m r
lifter (STT s m0 (MList s a) -> m (MList s a))
-> STT s m0 (MList s a) -> m (MList s a)
forall a b. (a -> b) -> a -> b
$ STRef s (MList s a) -> STT s m0 (MList s a)
forall (m :: * -> *) s a. Applicative m => STRef s a -> STT s m a
readSTRef STRef s (MList s a)
xsref
  (forall r. STT s m0 r -> m r) -> MList s a -> (a -> m ()) -> m ()
forall (m0 :: * -> *) (m :: * -> *) s a.
(Monad m0, Monad m) =>
(forall r. STT s m0 r -> m r) -> MList s a -> (a -> m ()) -> m ()
mlistFor_ forall r. STT s m0 r -> m r
lifter MList s a
xs a -> m ()
bodyf

-- |Like `mlistFor_`, but the body expects an `MCons` cell instead of
-- the list element itself.  Useful for mutating the list along the
-- way.
mlistForCons_ :: (Monad m0, Monad m) =>
  (forall r . STT s m0 r -> m r) -> MList s a -> (MList s a -> m ()) -> m ()
mlistForCons_ :: (forall r. STT s m0 r -> m r)
-> MList s a -> (MList s a -> m ()) -> m ()
mlistForCons_ forall r. STT s m0 r -> m r
_ MList s a
MNil MList s a -> m ()
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mlistForCons_ forall r. STT s m0 r -> m r
lifter mc :: MList s a
mc@(MCons STRef s a
_ STRef s (MList s a)
_) MList s a -> m ()
bodyf = do
  MList s a -> m ()
bodyf MList s a
mc
  MList s a
xs <- STT s m0 (MList s a) -> m (MList s a)
forall r. STT s m0 r -> m r
lifter (STT s m0 (MList s a) -> m (MList s a))
-> STT s m0 (MList s a) -> m (MList s a)
forall a b. (a -> b) -> a -> b
$ MList s a -> STT s m0 (MList s a)
forall (m :: * -> *) s a.
Applicative m =>
MList s a -> STT s m (MList s a)
mcdr MList s a
mc
  (forall r. STT s m0 r -> m r)
-> MList s a -> (MList s a -> m ()) -> m ()
forall (m0 :: * -> *) (m :: * -> *) s a.
(Monad m0, Monad m) =>
(forall r. STT s m0 r -> m r)
-> MList s a -> (MList s a -> m ()) -> m ()
mlistForCons_ forall r. STT s m0 r -> m r
lifter MList s a
xs MList s a -> m ()
bodyf

-- |A combination of `mlistForCons_` and
-- `Data.TMS.Helpers.forMwhile_`: iterate over the `MCons` cell of a
-- list, with a trigger for an early exit.  Note that the monad for
-- the continuation condition is over the overall monad @m@, not the
-- `STT` wrapped monad @m0@.
mlistForConsWhile_ ::
  (Monad m0, Monad m) =>
    (forall r . STT s m0 r -> m r) -> MList s a -> m Bool -> (MList s a -> m ())
      -> m ()
mlistForConsWhile_ :: (forall r. STT s m0 r -> m r)
-> MList s a -> m Bool -> (MList s a -> m ()) -> m ()
mlistForConsWhile_ forall r. STT s m0 r -> m r
_ MList s a
MNil m Bool
_ MList s a -> m ()
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mlistForConsWhile_ forall r. STT s m0 r -> m r
lifter mc :: MList s a
mc@(MCons STRef s a
_ STRef s (MList s a)
_) m Bool
moreM MList s a -> m ()
bodyf =
  m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM m Bool
moreM (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    MList s a -> m ()
bodyf MList s a
mc
    MList s a
xs <- STT s m0 (MList s a) -> m (MList s a)
forall r. STT s m0 r -> m r
lifter (STT s m0 (MList s a) -> m (MList s a))
-> STT s m0 (MList s a) -> m (MList s a)
forall a b. (a -> b) -> a -> b
$ MList s a -> STT s m0 (MList s a)
forall (m :: * -> *) s a.
Applicative m =>
MList s a -> STT s m (MList s a)
mcdr MList s a
mc
    (forall r. STT s m0 r -> m r)
-> MList s a -> m Bool -> (MList s a -> m ()) -> m ()
forall (m0 :: * -> *) (m :: * -> *) s a.
(Monad m0, Monad m) =>
(forall r. STT s m0 r -> m r)
-> MList s a -> m Bool -> (MList s a -> m ()) -> m ()
mlistForConsWhile_ forall r. STT s m0 r -> m r
lifter MList s a
xs m Bool
moreM MList s a -> m ()
bodyf

-- |Overwrite the @car@ slot of the given `MCons` with the given
-- value.  Named after the Common Lisp function with the same
-- behavior.
rplaca :: Monad m => MList s a -> a -> STT s m ()
rplaca :: MList s a -> a -> STT s m ()
rplaca (MCons STRef s a
r STRef s (MList s a)
_) a
v = STRef s a -> a -> STT s m ()
forall (m :: * -> *) s a.
Applicative m =>
STRef s a -> a -> STT s m ()
writeSTRef STRef s a
r a
v