-- | -- Module: Data.STM.TList -- Copyright: (c) Joseph Adams 2012 -- License: BSD3 -- Maintainer: joeyadams3.14159@gmail.com -- Portability: Requires STM -- -- This module uses many names from Prelude, so consider importing it -- qualified: -- -- >import Data.STM.TList (TList) -- >import qualified Data.STM.TList as TList {-# LANGUAGE BangPatterns, DeriveDataTypeable #-} module Data.STM.TList ( -- * The TList type TList, TCell(..), -- * Construction empty, emptyIO, cons, append, appendList, fromList, -- * Traversal -- | These functions traverse the list strictly. They examine the list as -- it is now; they do not 'retry' when the end of the list is reached. uncons, null, drop, end, length, foldl', toList, ) where import Prelude hiding (drop, length, null) import Control.Concurrent.STM import Control.Monad (foldM) import Data.Typeable (Typeable) ------------------------------------------------------------------------ -- The TList type -- | A 'TList' is a mutable linked list node. A 'TList' node containing 'TNil' -- is usually called a \"hole\" or \"write end\", and can be \"filled\" using -- 'append'. type TList a = TVar (TCell a) data TCell a = TNil | TCons a !(TList a) deriving Typeable ------------------------------------------------------------------------ -- Construction -- | /O(1)/. Construct a new, empty 'TList'. empty :: STM (TList a) empty = newTVar TNil -- | /O(1)/. 'IO' variant of 'empty'. See 'newTVarIO' for the rationale. emptyIO :: IO (TList a) emptyIO = newTVarIO TNil -- | /O(1)/. Prepend an item to the list, returning the new beginning of the -- list. cons :: a -> TList a -> STM (TList a) cons x xs = newTVar (TCons x xs) -- | /O(1)/. Append an item to the list, returning the new write end. -- -- The 'TList' normally points to a 'TNil', a \"hole\" into which the next item -- will be written. However, if it doesn't, 'append' will silently overwrite -- the next item. It is up to the application to ensure that the 'TList' -- points to a 'TNil', or that overwriting an item in this case is desirable. append :: TList a -> a -> STM (TList a) append hole x = do hole' <- empty writeTVar hole (TCons x hole') return hole' -- | /O(n)/. Append a list of items, returning the new write end. appendList :: TList a -> [a] -> STM (TList a) appendList = foldM append -- | /O(n)/. Convert a pure list to a 'TList', returning the head (read end) -- and tail (write end) of the list. fromList :: [a] -> STM (TList a, TList a) fromList xs = do readEnd <- empty writeEnd <- appendList readEnd xs return (readEnd, writeEnd) ------------------------------------------------------------------------ -- Traversal -- | /O(1)/. Get the next item of the list (if available). Handle 'TNil' (no -- items available) or 'TCons' (next item) using the appropriate continuation. -- -- The 'TList' argument being at the end means 'uncons' can be partially -- applied in many situations. uncons :: STM b -- ^ What to do if the list is empty -> (a -> TList a -> STM b) -- ^ What to do with the item and the remainder of the list -> TList a -- ^ List node to examine -> STM b uncons onNil onCons tl = do cell <- readTVar tl case cell of TNil -> onNil TCons x xs -> onCons x xs {-# INLINE uncons #-} -- | /O(1)/. Return 'True' if the list is empty. null :: TList a -> STM Bool null = uncons (return True) (\_ _ -> return False) -- | /O(n)/. Skip the given number of items. Return the end of the list if a -- 'TNil' is reached. drop :: Int -> TList a -> STM (TList a) drop n xs | n <= 0 = return xs | otherwise = uncons (return xs) (\_ xs' -> drop (n-1) xs') xs -- | /O(n)/. Traverse the list, stopping when a 'TNil' is reached. -- -- Bear in mind that 'TList's are mutable. In particular, the 'end' of a -- 'TList' is not as boring as the end of a pure list (@[]@, a.k.a. -- \"nil\"). It is usually the write end, to which additional items may be -- 'append'ed. end :: TList a -> STM (TList a) end xs = uncons (return xs) (\_ xs' -> end xs') xs -- | /O(n)/. Traverse the list, returning its length. length :: TList a -> STM Int length = len 0 where len !n = uncons (return n) (\_ -> len (n+1)) -- | /O(n)/. Traverse the list with an accumulator function and initial value. foldl' :: (a -> b -> a) -> a -> TList b -> STM a foldl' f a = uncons (return a) (\x -> let !a' = f a x in foldl' f a') -- | /O(n)/. Traverse a 'TList', returning its items as a pure list. toList :: TList a -> STM [a] toList = loop id where loop !dl = uncons (return $ dl []) (loop . (dl .) . (:))