1{-# LANGUAGE TypeFamilies #-}
2-- | Doubly-linked list
3module Data.Mutable.DLList
4    ( DLList
5    , asDLList
6    , module Data.Mutable.Class
7    ) where
8
9import Data.Mutable.Class
10
11data Node s a = Node
12    a
13    (MutVar s (Maybe (Node s a))) -- previous
14    (MutVar s (Maybe (Node s a))) -- next
15
16-- | A doubly-linked list.
17--
18-- Since 0.3.0
19data DLList s a = DLList (MutVar s (Maybe (Node s a))) (MutVar s (Maybe (Node s a)))
20
21-- |
22-- Since 0.2.0
23asDLList :: DLList s a -> DLList s a
24asDLList = id
25{-# INLINE asDLList #-}
26
27instance MutableContainer (DLList s a) where
28    type MCState (DLList s a) = s
29instance MutableCollection (DLList s a) where
30    type CollElement (DLList s a) = a
31    newColl = do
32        x <- newRef $! Nothing
33        y <- newRef $! Nothing
34        return $! DLList x y
35    {-# INLINE newColl #-}
36instance MutablePopFront (DLList s a) where
37    popFront (DLList frontRef backRef) = do
38        mfront <- readRef frontRef
39        case mfront of
40            Nothing -> return Nothing
41            Just (Node val _ nextRef) -> do
42                mnext <- readRef nextRef
43                case mnext of
44                    Nothing -> do
45                        writeRef frontRef $! Nothing
46                        writeRef backRef $! Nothing
47                    Just next@(Node _ prevRef _) -> do
48                        writeRef prevRef $! Nothing
49                        writeRef frontRef $! Just next
50                return $ Just val
51    {-# INLINE popFront #-}
52instance MutablePopBack (DLList s a) where
53    popBack (DLList frontRef backRef) = do
54        mback <- readRef backRef
55        case mback of
56            Nothing -> return Nothing
57            Just (Node val prevRef _) -> do
58                mprev <- readRef prevRef
59                case mprev of
60                    Nothing -> do
61                        writeRef frontRef $! Nothing
62                        writeRef backRef $! Nothing
63                    Just prev@(Node _ _ nextRef) -> do
64                        writeRef nextRef $! Nothing
65                        writeRef backRef (Just prev)
66                return $ Just val
67    {-# INLINE popBack #-}
68instance MutablePushFront (DLList s a) where
69    pushFront (DLList frontRef backRef) val = do
70        mfront <- readRef frontRef
71        case mfront of
72            Nothing -> do
73                prevRef <- newRef $! Nothing
74                nextRef <- newRef $! Nothing
75                let node = Just $ Node val prevRef nextRef
76                writeRef frontRef node
77                writeRef backRef node
78            Just front@(Node _ prevRef _) -> do
79                prevRefNew <- newRef $! Nothing
80                nextRef <- newRef $ Just front
81                let node = Just $ Node val prevRefNew nextRef
82                writeRef prevRef node
83                writeRef frontRef node
84    {-# INLINE pushFront #-}
85instance MutablePushBack (DLList s a) where
86    pushBack (DLList frontRef backRef) val = do
87        mback <- readRef backRef
88        case mback of
89            Nothing -> do
90                prevRef <- newRef $! Nothing
91                nextRef <- newRef $! Nothing
92                let node = Just $! Node val prevRef nextRef
93                writeRef frontRef $! node
94                writeRef backRef $! node
95            Just back@(Node _ _ nextRef) -> do
96                nextRefNew <- newRef $! Nothing
97                prevRef <- newRef $! Just back
98                let node = Just $! Node val prevRef nextRefNew
99                writeRef nextRef $! node
100                writeRef backRef $! node
101    {-# INLINE pushBack #-}
102