{-# LANGUAGE ExistentialQuantification, ScopedTypeVariables #-}
module Data.Sequence.IdMap
    ( Seq
    , empty
    , singleton
    , (<|)
    , (|>)
    , (><)
    , fromList
    , toList
    , viewr
    , ViewR (..)
    , viewl
    , ViewL (..)
--  , size
    ) where

import Data.IdMap hiding (insert)
import qualified Data.IdMap as M

import qualified Data.List as List
import Prelude hiding (last)


------------------------------------------

data Seq a 
    = forall k . Seq
        { first :: Id k
        , last  :: Id k
        , prev  :: {-# UNPACK #-} !(Map I0 k (Id k))
        , next  :: {-# UNPACK #-} !(Map I1 k (Id k))
        , value :: {-# UNPACK #-} !(Map I2 k a)
        }
    | Empty

empty :: Seq a
empty = Empty

singleton :: forall a. a -> Seq a
singleton a = runICC f where

    f :: ICC I2 v (Seq a)
    f (v `PlusMap` n `PlusMap` _) p (i:_) = Seq
        { first = i
        , last  = i
        , prev  = p
        , next  = n
        , value = M.insert i a v
        }
{-
    f :: ICC1 I2 v (Seq a)
    f (v `PlusMap1` n `PlusMap1` _) p (i:_) = Seq
        { first = i
        , last  = i
        , prev  = p
        , next  = n
        , value = M.insert i a v
        }
-}
(><) :: Seq a -> Seq a -> Seq a
Empty >< x = x
x >< Empty = x
(Seq f l p n v) >< (Seq f' l' p' n' v') 
    = Seq
        { first = left  f
        , last  = right l'
        , prev  = M.insert (right f') (left  l)  $ fmap left p `union` fmap right p'
        , next  = M.insert (left  l)  (right f') $ fmap left n `union` fmap right n'
        , value = v `union` v'
        }
        
(<|) :: a -> Seq a -> Seq a
a <| x = singleton a >< x

(|>) :: Seq a -> a -> Seq a
x |> a = x >< singleton a



data ViewR a
    = EmptyR
    | Seq a :> !a

viewr :: Seq a -> ViewR a
viewr Empty = EmptyR
viewr (Seq f l p n v) = s' :> vl where 

    vl = v M.! l

    s' = case lookUp l p of
        Nothing -> Empty
        Just pl -> Seq
            { first = f
            , last  = pl
            , prev  = p
            , next  = M.delete pl n
            , value = v
            }


data ViewL a
    = EmptyL
    | !a :< Seq a

viewl :: Seq a -> ViewL a
viewl Empty = EmptyL
viewl (Seq f l p n v) = vf :< s' where

    vf = v M.! f

    s' = case lookUp f n of
        Nothing -> Empty
        Just nf -> Seq
            { first = nf
            , last  = l
            , prev  = M.delete nf p
            , next  = n
            , value = v
            }




----------------------------


toList :: Seq a -> [a]
toList s = case viewl s of
    EmptyL  -> []
    a :< ss -> a: toList ss

fromList :: [a] -> Seq a
fromList l = List.foldl' (|>) empty l