import qualified Data.Map as M

type NodeID = Maybe Rational
data Node a = Node
   {vNode :: a,
    pNode, nNode :: NodeID}
type DLList a = M.Map Rational (Node a)

empty = M.empty

singleton a = M.singleton 0 $ Node a Nothing Nothing

fcons :: a -> DLList a -> DLList a
fcons a list | M.null list = singleton a
             | otherwise   = M.insert newid new $
                             M.insert firstid changed list
  where (firstid, Node firstval _ secondid) = M.findMin list
        newid = firstid - 1
        new     = Node a        Nothing      (Just firstid)
        changed = Node firstval (Just newid) secondid

rcons :: a -> DLList a -> DLList a
rcons a list | M.null list = singleton a
             | otherwise   = M.insert lastid changed $
                             M.insert newid new list
  where (lastid, Node lastval penultimateid _) = M.findMax list
        newid = lastid + 1
        changed = Node lastval penultimateid (Just newid)
        new     = Node a       (Just lastid) Nothing

mcons :: a -> Node a -> Node a -> DLList a -> DLList a
mcons a n1 n2 = M.insert n1id left .
    M.insert midid mid . M.insert n2id right
  where Node n1val farleftid   (Just n2id) = n1
        Node n2val (Just n1id) farrightid  = n2
        midid = (n1id + n2id) / 2   
        mid = Node a (Just n1id) (Just n2id)
        left  = Node n1val farleftid    (Just midid)
        right = Node n2val (Just midid) farrightid

firstNode :: DLList a -> Node a
firstNode = snd . M.findMin

lastNode :: DLList a -> Node a
lastNode = snd . M.findMax

nextNode :: DLList a -> Node a -> Maybe (Node a)
nextNode l n = nNode n >>= flip M.lookup l

prevNode :: DLList a -> Node a -> Maybe (Node a)
prevNode l n = pNode n >>= flip M.lookup l

fromList = foldr fcons empty

toList = map vNode . M.elems