Model an mutable pile of objects. Objects can be made visible and invisible 
and can be moved about in the stacking order.
It is implemented as an extensible array for fast update and access. Each entry
has a unique identifier (EltName) that is an instance of Eq,Ord and Ix.
Each entry also has an Ident which is the name of the object it is referring
to (such as a widget Id). Elements have a boolean saying whether visible,
and a pointer to the element above, below, the visible element above and the
visible element below.

Elements can be moved in the stacking order.
raise p e mb moves e to the top of the pile if mb is Nothing or above a if mb
is Just a.
lower p e mb moves e to the bottom of the pile if mb is Nothing or below a if
mb is Just a.

Piles can also have Groups (see Group.lhs). A group models a group of elements
that can be moved en-masse. Groups can also be moved above and below other
groups.

\begin{code}
module PileArray (
   module Group
  ,EltName,PileArray,EltData
  ,identElt -- :: EltData -> Ident
  ,pileArray -- :: Int -> IO PileArray
  ,getEltName -- :: PileArray -> IO EltName
  ,orderPileArray -- :: PileArray -> IO ([EltData],[EltData])
  ,getEltData -- :: PileArray -> EltName -> IO (Maybe EltData)
  ,nameElt -- :: EltData -> EltName
  ,isVisibleElt -- :: EltData -> Bool
  ,aboveElt,belowElt,visAboveElt,visBelowElt -- :: EltData -> Maybe EltName

  ,topElt,bottomElt,visTopElt,visBottomElt -- :: PileArray -> IO (Maybe EltName)

  ,insertPileElt -- :: PileArray -> EltName -> Maybe EltName 
                 -- -> [GroupRef] -> IO ()
  ,deletePileElt -- :: PileArray -> EltName -> IO ()
  ,hidePileElt -- :: PileArray -> EltName -> IO ()
  ,showPileElt -- :: PileArray -> EltName -> IO ()
  ,raisePileElt -- :: PileArray -> EltName -> Maybe EltName -> IO ()
  ,lowerPileElt -- :: PileArray -> EltName -> Maybe EltName -> IO ()
  ,raisePileGp -- :: PileArray -> GroupRef -> Maybe EltName -> IO ()
  ,lowerPileGp -- :: PileArray -> GroupRef -> Maybe EltName -> IO ()
  ,raisePileGp' -- ::PileArray -> GroupRef -> Maybe GroupRef -> IO ()
  ,lowerPileGp' -- ::PileArray -> GroupRef -> Maybe GroupRef -> IO ()
 )
 where
import Array
import IOExts
import PlacePos
import ExtArray
import Monad
import Maybe
import Group
import Identify


data EltData = EltData {nameElt_ :: EltName,
                        aboveElt_ :: Maybe EltName,belowElt_ :: Maybe EltName,
                        visAboveElt_ :: Maybe EltName,visBelowElt_ :: Maybe EltName,
                        visibleElt_ :: Bool,
			identElt :: Ident,
                        groupRef :: [GroupRef]}

instance Show EltData where
 show (EltData nm abv below visabv visbelow visible id _) = 
   show ("EltData",nm,abv,below,(visabv,visbelow,visible,id)) ++ "\n"

nameElt :: EltData -> EltName
nameElt = nameElt_

isVisibleElt :: EltData -> Bool
isVisibleElt = visibleElt_

aboveElt,belowElt,visAboveElt,visBelowElt :: EltData -> Maybe EltName
aboveElt = aboveElt_
belowElt = belowElt_
visAboveElt = visAboveElt_
visBelowElt = visBelowElt_

data PileArray = PileArray {pileArray_ :: ExtArray EltData,
			    posPointers_ :: IORef PosPointers}


orderPileArray :: PileArray -> IO ([EltData],[EltData])
orderPileArray (PileArray a pv) = do
 ps <- readIORef pv
 es <- traverse' a belowElt_ (topName ps) 
 print es
 vs <- traverse' a visBelowElt_ (visTopName ps) 
 return (es, vs)

traverse' :: ExtArray EltData -> (EltData -> Maybe EltName) -> Maybe EltName 
          -> IO [EltData]
traverse' a f Nothing = return []
traverse' a f (Just n) = do
 pMb <- lookupElt a n
 case pMb of
   Nothing -> do print ("traverse error",n)
                 return []
   Just p -> do ts <- traverse' a f (f p)
                return $ p:ts

getEltName :: PileArray -> IO EltName
getEltName (PileArray {pileArray_ = arr}) = do 
 nm <- nextExtEntry arr
 return $ toElt nm 

getEltData :: PileArray -> EltName -> IO (Maybe EltData)
getEltData (PileArray {pileArray_ = arr}) e = lookupElt arr e

topElt,bottomElt,visTopElt,visBottomElt :: PileArray -> IO (Maybe EltName)
topElt = getElt topName
bottomElt = getElt bottomName
visTopElt = getElt visTopName
visBottomElt = getElt visBottomName
 
getElt :: (PosPointers -> Maybe EltName) -> PileArray -> IO (Maybe EltName)
getElt f (PileArray {posPointers_ = pv}) = do
 ps <- readIORef pv
 return $ f ps

pileArray :: Int -> IO PileArray
pileArray n = do
 ext <- newExtArray n 
 v <- newIORef initPosPointers
 return $ PileArray ext v 

updGp :: EltName 
      -> Maybe EltName -> Maybe EltName -> Maybe EltName -> Maybe EltName
      -> Bool -> GroupRef -> IO ()
updGp e mba mbb mbva mbvb visible gr = do
 updGp' (const True) e e e e mba mbb mbva mbvb visible gr

updGp' :: (Ident -> Bool) -> EltName -> EltName -> EltName -> EltName 
      -> Maybe EltName -> Maybe EltName -> Maybe EltName -> Maybe EltName
      -> Bool -> GroupRef -> IO ()
updGp' doG eT eB eVT eVB mba mbb mbva mbvb visible gr = do
 gp@(GroupData {groupName = gn,
		posPointers = 
                   (PosPointers {topName = top,
  	                         bottomName = bottom,
	                         visTopName = vistop,
	                         visBottomName = visbottom})
               ,groupMembers = gs}) <- readIORef gr
 when (doG gn) $ do
  let upd e v mb = if (isJust v && mb == v) || not (isJust v) then Just e else v
  writeIORef gr $ gp {posPointers = 
                        PosPointers (upd eT top mbb) (upd eB bottom mba)
                                    (if not visible then vistop else upd eVT vistop mbvb)
                                    (if not visible then visbottom else upd eVB visbottom mbva)}    

 
updDelGps :: EltData -> Bool -> Bool -> IO ()
updDelGps (EltData {aboveElt_ = mba,belowElt_ = mbb,visAboveElt_ = mbva,visBelowElt_ = mbvb,
                    groupRef = grs,nameElt_ = e}) doalways dovis = do
 updDelGps' (const True) e e e e mba mbb mbva mbvb doalways dovis grs

updDelGps' :: (Ident -> Bool) -> EltName -> EltName -> EltName -> EltName
           -> Maybe EltName -> Maybe EltName -> Maybe EltName -> Maybe EltName
           -> Bool -> Bool -> [GroupRef] -> IO ()
updDelGps' doGp eT eB eVT eVB mba mbb mbva mbvb doalways dovis grs =
 mapM_ updDelGp grs
  where
   updDelGp gr = do
    gp@(GroupData {groupName = gn,
		   posPointers = 
                   (PosPointers {topName = top,
  	                         bottomName = bottom,
	                         visTopName = vistop,
	                         visBottomName = visbottom})}) <- readIORef gr
    when (doGp gn) $ do
     let upd e v mb = if Just e == v then mb else v
     writeIORef gr $ gp {posPointers = 
                       PosPointers (if not doalways then top else upd eT top mbb) 
                                   (if not doalways then bottom else upd eB bottom mba) 
                                   (if not dovis then vistop else upd eVT vistop mbvb)
                                   (if not dovis then visbottom else upd eVB visbottom mbva)}

showGpElt :: EltName -> Maybe EltName -> Maybe EltName -> GroupRef -> IO ()
showGpElt e mba mbb gr = do
  gp@(GroupData {groupMembers = gs,
		 posPointers = 
                   ps@(PosPointers {visTopName = vistop,
	                            visBottomName = visbottom})}) <- readIORef gr
  let topv = maybe (Just e) (\v -> if v `elem` gs then vistop else Just e) mba
      bottomv = maybe (Just e) (\v -> if v `elem` gs then visbottom else Just e) mbb

  writeIORef gr $ gp {posPointers = ps {visTopName = topv,visBottomName = bottomv}}

raiseOrLowerPileGp' :: Bool -> PileArray -> GroupRef -> Maybe GroupRef 
                    -> IO (Maybe EltName)
raiseOrLowerPileGp' isRaise pile gr mbg = do
 mbe <- getWhatElt mbg
 raiseOrLowerPileGp isRaise pile gr mbe
 return mbe
   where
    getWhatElt Nothing = return Nothing
    getWhatElt (Just gr) = do
       gp@(GroupData {posPointers = ps}) <- readIORef gr
       return $ if isRaise then topName ps else bottomName ps


raiseOrLowerPileGp :: Bool -> PileArray -> GroupRef -> Maybe EltName 
                   -> IO ()
raiseOrLowerPileGp isRaise pile gr mbn = do
 gp@(GroupData {groupName = gn,
		groupMembers = gs,
		posPointers = ps}) <- readIORef gr
 if maybe False (`elem` gs) mbn then do
     print "attempt to raise gp above one of its own members!"
     return ()
  else
     handleOp (handle isRaise mbn gn ps) pile
 where
  handle isRaise mbn gn 
         psg@(PosPointers {topName = topG,bottomName = bottomG,
                           visTopName = vistopG,visBottomName = visbottomG}) 
         ps@(PosPointers {topName = top,bottomName = bottom,
                          visTopName = vistop,visBottomName = visbottom}) 
         a = do
   let get = maybe (return Nothing) (lookupElt a)
   nt <- get topG
   nb <- get bottomG
   ntv <- get vistopG
   nbv <- get visbottomG
   case (nt,nb,ntv,nbv) of
    (Nothing,Nothing,_,_) -> do return ps
    (Just nte,Just nbe,ntveMb,nbveMb) -> 
      let aboveElt = aboveElt_ nte
          belowElt = belowElt_ nbe
          nteL = nameElt_ nte
          nbeL = nameElt_ nbe
          nteVL = maybe (error "not visible") nameElt_ ntveMb
          nbeVL = maybe (error "not visible") nameElt_ nbveMb
          visAboveElt = maybe Nothing visAboveElt_ ntveMb
          visBelowElt = maybe Nothing visBelowElt_ nbveMb
          ntve = maybe (error "not visible") id ntveMb
          nbve = maybe (error "not visible") id nbveMb
          visibleElt = isJust ntveMb && isJust nbveMb
          allgs = groupRef nte -- assumes all members of this group are in all same
		 		-- parent groups
      in
      if (isRaise && isJust belowElt && belowElt == mbn) || 
         (not isRaise && isJust aboveElt && aboveElt == mbn) then
         return ps
      else do
        (top,bottom) <- removeData top bottom aboveElt belowElt updAboveElt updBelowElt a
        (vistop,visbottom) <- 
         if visibleElt then do
              updDelGps' (/= gn) nteL nbeL nteVL nbeVL aboveElt belowElt visAboveElt visBelowElt
			 True True allgs
              removeData vistop visbottom visAboveElt visBelowElt 
                         updVisAboveElt updVisBelowElt a
         else do
              updDelGps' (/= gn) nteL nbeL nteVL nbeVL aboveElt belowElt visAboveElt visBelowElt
			 True False allgs
              return (vistop,visbottom) 
        (above',below',top',bottom') <- 
         if isRaise then 
              aboveData nteL nbeL mbn top bottom (lookupElt' a aboveElt_)
                        updAboveElt updBelowElt a False
         else
              belowData nteL nbeL mbn top bottom (lookupElt' a belowElt_)
                        updAboveElt updBelowElt a False
        (abovev,belowv,topv,bottomv) <- 
         if visibleElt then
           if isRaise then 
               aboveData nteVL nbeVL mbn vistop visbottom (lookupElt' a visAboveElt_)
  			 updVisAboveElt updVisBelowElt a True
           else
               belowData nteVL nbeVL mbn vistop visbottom (lookupElt' a visBelowElt_)
  			 updVisAboveElt updVisBelowElt a True
         else
               return (visAboveElt,visBelowElt,vistop,visbottom)
        mapM (updGp' (/= gn) nteL nbeL nteVL nbeVL above' below' abovev belowv visibleElt) allgs
        updElt a nteL (\e -> e {aboveElt_ = above'})
        updElt a nbeL (\e -> e {belowElt_ = below'})
        when visibleElt $ do
            updElt a nteVL (\e -> e {visAboveElt_ = abovev})
            updElt a nbeVL (\e -> e {visBelowElt_ = belowv})
        return $ PosPointers top' bottom' topv bottomv
    _ -> do print "error pilearray";return ps 

insertPileElt :: PileArray -> Ident -> EltName -> Maybe EltName -> [GroupRef] 
              -> IO ()
deletePileElt :: PileArray -> EltName -> IO ()
hidePileElt :: PileArray -> EltName -> IO ()
showPileElt :: PileArray -> EltName -> IO ()
raisePileElt :: PileArray -> EltName -> Maybe EltName -> IO ()
lowerPileElt :: PileArray -> EltName -> Maybe EltName -> IO ()
raisePileGp :: PileArray -> GroupRef -> Maybe EltName -> IO ()
lowerPileGp :: PileArray -> GroupRef -> Maybe EltName -> IO ()
raisePileGp' ::PileArray -> GroupRef -> Maybe GroupRef -> IO (Maybe EltName)
lowerPileGp' ::PileArray -> GroupRef -> Maybe GroupRef -> IO (Maybe EltName)

raisePileGp' = raiseOrLowerPileGp' True
lowerPileGp' = raiseOrLowerPileGp' False
raisePileGp = raiseOrLowerPileGp True
lowerPileGp = raiseOrLowerPileGp False

insertPileElt pile ident n mbn mbg = handleOp (handle n mbn) pile
 where
  handle n mbn
         pos@(PosPointers {topName = top,
	 	           bottomName = bottom,
		           visTopName = vistop,
		           visBottomName = visbottom})
         a = do
   (above',below',top',bottom') <- aboveData n n mbn top bottom (lookupElt' a aboveElt_)
                                             updAboveElt updBelowElt a False
   (abovev,belowv,topv,bottomv) <- aboveData n n mbn vistop visbottom 
					     (lookupElt' a visAboveElt_)
					     updVisAboveElt updVisBelowElt a True
   mapM (\g -> do updGp n above' below' abovev belowv True g
                  insertInGroup g n) mbg
   writeElt a n (EltData n above' below' abovev belowv True ident mbg)
   return $ PosPointers top' bottom' topv bottomv


deletePileElt pile n = handleOp (handle n ) pile
 where
  handle n 
         pos@(PosPointers {topName = top,
	 	           bottomName = bottom,
		           visTopName = vistop,
		           visBottomName = visbottom})
         a = do
   maybeIO (return pos) (lookupElt a n) $ \e -> do
     (top',bottom') <- removeData top bottom (aboveElt_ e) (belowElt_ e) 
                                  updAboveElt updBelowElt a 
     (topv,bottomv) <- 
         if visibleElt_ e then
              removeData vistop visbottom (visAboveElt_ e) (visBelowElt_ e) 
                         updVisAboveElt updVisBelowElt a
         else 
              return (vistop,visbottom) 
     updDelGps e True True
     mapM (flip deleteFromGroup n) (groupRef e)
     clearElt a n
     return $ PosPointers top' bottom' topv bottomv

hidePileElt pile n = handleOp (handle n ) pile
 where
  handle n 
         pos@(PosPointers {topName = top,
	 	           bottomName = bottom,
		           visTopName = vistop,
		           visBottomName = visbottom})
         a = do
   maybeIO (return pos) (lookupElt a n) $ \e ->
     if not (visibleElt_ e) then
        return pos
     else do
       (topv,bottomv) <- removeData vistop visbottom (visAboveElt_ e) (visBelowElt_ e) 
                                    updVisAboveElt updVisBelowElt a
       updDelGps e False True
       writeElt a n (e {visibleElt_ = False,visAboveElt_ = Nothing,visBelowElt_ = Nothing})
       return $ PosPointers top bottom topv bottomv

showPileElt pile n  = handleOp (handle n ) pile
 where
  handle n 
         pos@(PosPointers {topName = top,
	 	           bottomName = bottom,
		           visTopName = vistop,
		           visBottomName = visbottom})
         a = do
   maybeIO (return pos) (lookupElt a n) $ \e ->
     if visibleElt_ e then
        return pos
     else do
       aboveD <- traverse a aboveElt_ (aboveElt_ e)
       belowD <- traverse a belowElt_ (belowElt_ e)
       let above = fmap nameElt_ aboveD
       let below = fmap nameElt_ belowD
       writeElt a n (e {visibleElt_ = True,
                        visAboveElt_ = above,
                        visBelowElt_ = below})
       when (isJust above) $ updElt a (fromJust above) (updVisBelowElt $ Just n)
       when (isJust below) $ updElt a (fromJust below) (updVisAboveElt $ Just n)
       mapM (showGpElt n above below) (groupRef e)
       return $ PosPointers top bottom (maybe (Just n) (const vistop) above)
                                       (maybe (Just n) (const visbottom) below)


raisePileElt pile n mbn = handleOp (raiseOrLower True n mbn) pile

lowerPileElt pile n mbn = handleOp (raiseOrLower False n mbn) pile


raiseOrLower :: Bool -> EltName -> Maybe EltName -> PosPointers -> ExtArray EltData 
             -> IO PosPointers
raiseOrLower isRaise n mbn
         pos@(PosPointers {topName = top,
	 	           bottomName = bottom,
		           visTopName = vistop,
		           visBottomName = visbottom})
         a = do
   maybeIO (return pos) (lookupElt a n) $ \e ->
    if (isRaise && isJust (belowElt_ e) && belowElt_ e == mbn) || 
       (not isRaise && isJust (aboveElt_ e) && aboveElt_ e == mbn) then
     return pos
    else do
     (top,bottom) <- removeData top bottom (aboveElt_ e) (belowElt_ e) 
                                  updAboveElt updBelowElt a 
     (vistop,visbottom) <- 
         if visibleElt_ e then do
              updDelGps e True True
              removeData vistop visbottom (visAboveElt_ e) (visBelowElt_ e) 
                         updVisAboveElt updVisBelowElt a
         else do
              updDelGps e True False
              return (vistop,visbottom) 
     (above',below',top',bottom') <- 
         if isRaise then
              aboveData n n mbn top bottom (lookupElt' a aboveElt_)
                        updAboveElt updBelowElt a False
         else
              belowData n n mbn top bottom (lookupElt' a belowElt_)
                        updAboveElt updBelowElt a False
     (abovev,belowv,topv,bottomv) <- 
         if visibleElt_ e then 
           if isRaise then 
               aboveData n n mbn vistop visbottom (lookupElt' a visAboveElt_)
  			 updVisAboveElt updVisBelowElt a True
           else
               belowData n n mbn vistop visbottom (lookupElt' a visBelowElt_)
  			 updVisAboveElt updVisBelowElt a True
         else
               return (visAboveElt_ e,visBelowElt_ e,vistop,visbottom)

     mapM (updGp n above' below' abovev belowv (visibleElt_ e)) (groupRef e)

     writeElt a n (e {aboveElt_ = above',belowElt_ = below',
                      visAboveElt_ = abovev,visBelowElt_ = belowv})
     return $ PosPointers top' bottom' topv bottomv

maybeIO :: IO a -> (IO (Maybe b)) -> (b -> IO a)  -> IO a
maybeIO doA act doB = do 
  dMb <- act
  case dMb of
   Nothing -> doA
   Just d -> doB d

updAboveElt :: Maybe EltName -> EltData -> EltData
updAboveElt a p = p {aboveElt_ = a}

updBelowElt :: Maybe EltName -> EltData -> EltData
updBelowElt a p = p {belowElt_ = a}

updVisBelowElt :: Maybe EltName -> EltData -> EltData
updVisBelowElt a p = p {visBelowElt_ = a}

updVisAboveElt :: Maybe EltName -> EltData -> EltData
updVisAboveElt a p = p {visAboveElt_ = a}


aboveData :: EltName -> EltName -> Maybe EltName -> Maybe EltName -> Maybe EltName 
          -> (EltName -> IO (Maybe EltName)) 
          -> (Maybe EltName -> EltData -> EltData)
          -> (Maybe EltName -> EltData -> EltData)
          -> ExtArray EltData 
          -> Bool
          -> IO (Maybe EltName,Maybe EltName,Maybe EltName,Maybe EltName)
aboveData nte nbe Nothing top bottom _ updAbove _ a _ = do
      when (isJust top) $ updElt a (fromJust top) (updAbove $ Just nbe)
      return (Nothing,top,Just nte,bottom `mplus` Just nbe)
aboveData nte nbe (Just n') top bottom getAbove updAbove updBelow a justvis = do
    nd <- lookupElt a n'
    case nd of
     Nothing -> return (Nothing,top,Just nte,bottom `mplus` Just nbe)
     Just (EltData {visibleElt_ = False,belowElt_ = bel}) | justvis -> do
       mbd <- traverse a belowElt_ bel
       aboveData nte nbe (fmap nameElt_ mbd) top bottom getAbove updAbove updBelow a justvis
     Just _ -> do  
      na <- getAbove n'
      updElt a n' (updAbove $ Just nbe)
      when (isJust na) $ updElt a (fromJust na) (updBelow $ Just nte)
      return (na,Just n',
              if Just n' == top || Nothing == top then Just nte  
              else top,
              bottom `mplus` Just nbe)

belowData :: EltName -> EltName -> Maybe EltName -> Maybe EltName -> Maybe EltName 
          -> (EltName -> IO (Maybe EltName)) 
          -> (Maybe EltName -> EltData -> EltData)
          -> (Maybe EltName -> EltData -> EltData)
          -> ExtArray EltData 
          -> Bool
          -> IO (Maybe EltName,Maybe EltName,Maybe EltName,Maybe EltName)
belowData nte nbe Nothing top bottom _ updAbove updBelow a _ = do
      when (isJust bottom) $ updElt a (fromJust bottom) (updBelow $ Just nte)
      return (bottom,Nothing,top `mplus` Just nte,Just nbe) 
belowData nte nbe (Just n') top bottom getBelow updAbove updBelow a justvis = do
    nd <- lookupElt a n'
    case nd of
     Nothing -> return (bottom,Nothing,top `mplus` Just nbe,Just nbe)
     Just (EltData {visibleElt_ = False,aboveElt_ = abov}) | justvis -> do
       mbd <- traverse a aboveElt_ abov
       belowData nte nbe (fmap nameElt_ mbd) top bottom getBelow updAbove updBelow a justvis
     Just _ -> do  
      nb <- getBelow n'
      updElt a n' (updBelow $ Just nte)
      when (isJust nb) $ updElt a (fromJust nb) (updAbove $ Just nbe)
      return (Just n',nb,
                top `mplus` Just nte,
                if Just n' == bottom || Nothing == bottom then Just nbe else bottom)


removeData :: Maybe EltName -> Maybe EltName
           -> Maybe EltName -> Maybe EltName 
           -> (Maybe EltName -> EltData -> EltData)
           -> (Maybe EltName -> EltData -> EltData)
           -> ExtArray EltData
           -> IO (Maybe EltName,Maybe EltName)
removeData top bottom na nb updAbove updBelow a = do
           case (na,nb) of
             (Nothing,Just n') -> do
                 updElt a n' (updAbove Nothing)
                 return $ (Just n',bottom)
             (Just n',Nothing) -> do
                 updElt a n' (updBelow Nothing)
                 return $ (top,Just n')
             (Just na',Just nb') -> do
                 updElt a na' (updBelow nb)  
                 updElt a nb' (updAbove na)
                 return $ (top,bottom)
             (Nothing,Nothing) -> do
                 return $ (Nothing,Nothing)

traverse :: ExtArray EltData -> (EltData -> Maybe EltName) -> Maybe EltName 
         -> IO (Maybe EltData)
traverse a f Nothing = return Nothing
traverse a f (Just n) = do
 pMb <- lookupElt a n
 case pMb of
   Nothing -> do print ("traverse error",n)
                 return Nothing
   Just p -> if visibleElt_ p then return $ Just p
             else traverse a f (f p)

handleOp :: (PosPointers -> ExtArray EltData -> IO PosPointers) 
         -> PileArray
         -> IO ()
handleOp f (PileArray {posPointers_ = pv,pileArray_ = pile}) = do 
 ps <- readIORef pv
 f ps pile >>= writeIORef pv  

lookupElt :: ExtArray EltData -> EltName -> IO (Maybe EltData) 
lookupElt arr e = readExtArray arr $ fromElt e

lookupElt' :: ExtArray EltData -> (EltData -> Maybe EltName) 
           -> EltName ->  IO (Maybe EltName) 
lookupElt' arr f e = do 
 mbE <- lookupElt arr e
 return $ maybe Nothing f mbE

writeElt :: ExtArray EltData -> EltName -> EltData -> IO ()
writeElt arr e ed = writeExtArray arr (fromElt e) ed

clearElt :: ExtArray EltData -> EltName -> IO ()
clearElt arr e = clearExtArray arr (fromElt e)

updElt :: ExtArray EltData -> EltName -> (EltData -> EltData) -> IO ()
updElt arr e f = updExtArray arr (fromElt e) f
 
\end{code}