module Data.Homeomorphic.ShellId(
    ShellIds, ShellId(..), empty, retrieve
    ) where

import qualified Data.Map as Map
import Data.List
import Data.Homeomorphic.Internal


data ShellId = ShellId {allId :: Int, headId :: Int, restId :: [ShellId]}

data ShellIds k = ShellIds
    (Map.Map (Shell k) ShellId)  -- for the entire result
    (Map.Map (k,Int) Int)              -- for the headId


empty :: ShellIds k
empty = ShellIds Map.empty Map.empty


retrieve :: Ord k => Shell k -> ShellIds k -> (ShellIds k, ShellId)
retrieve x@(Shell a b c) o@(ShellIds mAll mHead) =
    case Map.lookup x mAll of
        Just y -> (o, y)
        Nothing -> (ShellIds mAll3 mHead3, rAll)
            where
                (ShellIds mAll2 mHead2, cs) = mapAccumL (flip retrieve) o c
                (mHead3, rHead) = retrieveHead (a,b) mHead2
                rAll = ShellId (Map.size mAll2) rHead cs
                mAll3 = Map.insert x rAll mAll2
                  


retrieveHead :: Ord k => (k,Int) -> Map.Map (k,Int) Int -> (Map.Map (k,Int) Int, Int)
retrieveHead x m =
    case Map.lookup x m of
        Just y -> (m, y)
        Nothing -> (Map.insert x r m, r)
            where r = Map.size m