module Erebos.Storage.List (
    StoredList,
    emptySList, fromSList, storedFromSList,
    slistAdd, slistAddS,
    -- TODO slistInsert, slistInsertS,
    slistRemove, slistReplace, slistReplaceS,
    -- TODO mapFromSList, updateOld,

    -- TODO StoreUpdate(..),
    -- TODO withStoredListItem, withStoredListItemS,
) where

import Data.List
import Data.Maybe
import qualified Data.Set as S

import Erebos.Storage
import Erebos.Storage.Internal
import Erebos.Storage.Merge

data List a = ListNil
            | ListItem { forall a. List a -> [StoredList a]
listPrev :: [StoredList a]
                       , forall a. List a -> Maybe (Stored a)
listItem :: Maybe (Stored a)
                       , forall a. List a -> Maybe (StoredList a)
listRemove :: Maybe (Stored (List a))
                       }

type StoredList a = Stored (List a)

instance Storable a => Storable (List a) where
    store' :: List a -> Store
store' List a
ListNil = Store
storeZero
    store' x :: List a
x@ListItem {} = (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
storeRec ((forall (c :: * -> *). StorageCompleteness c => StoreRec c)
 -> Store)
-> (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
forall a b. (a -> b) -> a -> b
$ do
        (StoredList a -> StoreRec c) -> [StoredList a] -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> StoredList a -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"PREV") ([StoredList a] -> StoreRec c) -> [StoredList a] -> StoreRec c
forall a b. (a -> b) -> a -> b
$ List a -> [StoredList a]
forall a. List a -> [StoredList a]
listPrev List a
x
        (Stored a -> StoreRec c) -> Maybe (Stored a) -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> Stored a -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"item") (Maybe (Stored a) -> StoreRec c) -> Maybe (Stored a) -> StoreRec c
forall a b. (a -> b) -> a -> b
$ List a -> Maybe (Stored a)
forall a. List a -> Maybe (Stored a)
listItem List a
x
        (StoredList a -> StoreRec c) -> Maybe (StoredList a) -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> StoredList a -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"remove") (Maybe (StoredList a) -> StoreRec c)
-> Maybe (StoredList a) -> StoreRec c
forall a b. (a -> b) -> a -> b
$ List a -> Maybe (StoredList a)
forall a. List a -> Maybe (StoredList a)
listRemove List a
x

    load' :: Load (List a)
load' = Load Object
loadCurrentObject Load Object -> (Object -> Load (List a)) -> Load (List a)
forall a b. Load a -> (a -> Load b) -> Load b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Object
ZeroObject -> List a -> Load (List a)
forall a. a -> Load a
forall (m :: * -> *) a. Monad m => a -> m a
return List a
forall a. List a
ListNil
        Object
_ -> LoadRec (List a) -> Load (List a)
forall a. LoadRec a -> Load a
loadRec (LoadRec (List a) -> Load (List a))
-> LoadRec (List a) -> Load (List a)
forall a b. (a -> b) -> a -> b
$ [StoredList a]
-> Maybe (Stored a) -> Maybe (StoredList a) -> List a
forall a.
[StoredList a]
-> Maybe (Stored a) -> Maybe (StoredList a) -> List a
ListItem ([StoredList a]
 -> Maybe (Stored a) -> Maybe (StoredList a) -> List a)
-> LoadRec [StoredList a]
-> LoadRec (Maybe (Stored a) -> Maybe (StoredList a) -> List a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> LoadRec [StoredList a]
forall a. Storable a => String -> LoadRec [a]
loadRefs String
"PREV"
                                LoadRec (Maybe (Stored a) -> Maybe (StoredList a) -> List a)
-> LoadRec (Maybe (Stored a))
-> LoadRec (Maybe (StoredList a) -> List a)
forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> LoadRec (Maybe (Stored a))
forall a. Storable a => String -> LoadRec (Maybe a)
loadMbRef String
"item"
                                LoadRec (Maybe (StoredList a) -> List a)
-> LoadRec (Maybe (StoredList a)) -> LoadRec (List a)
forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> LoadRec (Maybe (StoredList a))
forall a. Storable a => String -> LoadRec (Maybe a)
loadMbRef String
"remove"

instance Storable a => ZeroStorable (List a) where
    fromZero :: Storage -> List a
fromZero Storage
_ = List a
forall a. List a
ListNil


emptySList :: Storable a => Storage -> IO (StoredList a)
emptySList :: forall a. Storable a => Storage -> IO (StoredList a)
emptySList Storage
st = Storage -> List a -> IO (Stored (List a))
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Storage -> a -> m (Stored a)
wrappedStore Storage
st List a
forall a. List a
ListNil

groupsFromSLists :: forall a. Storable a => StoredList a -> [[Stored a]]
groupsFromSLists :: forall a. Storable a => StoredList a -> [[Stored a]]
groupsFromSLists = Set (StoredList a) -> [StoredList a] -> [[Stored a]]
helperSelect Set (StoredList a)
forall a. Set a
S.empty ([StoredList a] -> [[Stored a]])
-> (StoredList a -> [StoredList a]) -> StoredList a -> [[Stored a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoredList a -> [StoredList a] -> [StoredList a]
forall a. a -> [a] -> [a]
:[])
  where
    helperSelect :: S.Set (StoredList a) -> [StoredList a] -> [[Stored a]]
    helperSelect :: Set (StoredList a) -> [StoredList a] -> [[Stored a]]
helperSelect Set (StoredList a)
rs [StoredList a]
xxs | StoredList a
x:[StoredList a]
xs <- [StoredList a] -> [StoredList a]
forall a. Ord a => [a] -> [a]
sort ([StoredList a] -> [StoredList a])
-> [StoredList a] -> [StoredList a]
forall a b. (a -> b) -> a -> b
$ Set (StoredList a) -> [StoredList a] -> [StoredList a]
filterRemoved Set (StoredList a)
rs [StoredList a]
xxs = Set (StoredList a)
-> StoredList a -> [StoredList a] -> [[Stored a]]
helper Set (StoredList a)
rs StoredList a
x [StoredList a]
xs
                        | Bool
otherwise = []

    helper :: S.Set (StoredList a) -> StoredList a -> [StoredList a] -> [[Stored a]]
    helper :: Set (StoredList a)
-> StoredList a -> [StoredList a] -> [[Stored a]]
helper Set (StoredList a)
rs StoredList a
x [StoredList a]
xs
        | List a
ListNil <- StoredList a -> List a
forall a. Stored a -> a
fromStored StoredList a
x
        = []

        | Just StoredList a
rm <- List a -> Maybe (StoredList a)
forall a. List a -> Maybe (StoredList a)
listRemove (StoredList a -> List a
forall a. Stored a -> a
fromStored StoredList a
x)
        , Set (StoredList a)
ans <- [StoredList a] -> Set (StoredList a)
forall a. Storable a => [Stored a] -> Set (Stored a)
ancestors [StoredList a
x]
        , ([StoredList a]
other, [StoredList a]
collision) <- (StoredList a -> Bool)
-> [StoredList a] -> ([StoredList a], [StoredList a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Set (StoredList a) -> Bool
forall a. Set a -> Bool
S.null (Set (StoredList a) -> Bool)
-> (StoredList a -> Set (StoredList a)) -> StoredList a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (StoredList a) -> Set (StoredList a) -> Set (StoredList a)
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set (StoredList a)
ans (Set (StoredList a) -> Set (StoredList a))
-> (StoredList a -> Set (StoredList a))
-> StoredList a
-> Set (StoredList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StoredList a] -> Set (StoredList a)
forall a. Storable a => [Stored a] -> Set (Stored a)
ancestors ([StoredList a] -> Set (StoredList a))
-> (StoredList a -> [StoredList a])
-> StoredList a
-> Set (StoredList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoredList a -> [StoredList a] -> [StoredList a]
forall a. a -> [a] -> [a]
:[])) [StoredList a]
xs
        , [[Stored a]]
cont <- Set (StoredList a) -> [StoredList a] -> [[Stored a]]
helperSelect (Set (StoredList a)
rs Set (StoredList a) -> Set (StoredList a) -> Set (StoredList a)
forall a. Ord a => Set a -> Set a -> Set a
`S.union` [StoredList a] -> Set (StoredList a)
forall a. Storable a => [Stored a] -> Set (Stored a)
ancestors [StoredList a
rm]) ([StoredList a] -> [[Stored a]]) -> [StoredList a] -> [[Stored a]]
forall a b. (a -> b) -> a -> b
$ (StoredList a -> [StoredList a])
-> [StoredList a] -> [StoredList a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (List a -> [StoredList a]
forall a. List a -> [StoredList a]
listPrev (List a -> [StoredList a])
-> (StoredList a -> List a) -> StoredList a -> [StoredList a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoredList a -> List a
forall a. Stored a -> a
fromStored) (StoredList a
x StoredList a -> [StoredList a] -> [StoredList a]
forall a. a -> [a] -> [a]
: [StoredList a]
collision) [StoredList a] -> [StoredList a] -> [StoredList a]
forall a. [a] -> [a] -> [a]
++ [StoredList a]
other
        = case [Maybe (Stored a)] -> [Stored a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Stored a)] -> [Stored a])
-> [Maybe (Stored a)] -> [Stored a]
forall a b. (a -> b) -> a -> b
$ (StoredList a -> Maybe (Stored a))
-> [StoredList a] -> [Maybe (Stored a)]
forall a b. (a -> b) -> [a] -> [b]
map (List a -> Maybe (Stored a)
forall a. List a -> Maybe (Stored a)
listItem (List a -> Maybe (Stored a))
-> (StoredList a -> List a) -> StoredList a -> Maybe (Stored a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoredList a -> List a
forall a. Stored a -> a
fromStored) (StoredList a
x StoredList a -> [StoredList a] -> [StoredList a]
forall a. a -> [a] -> [a]
: [StoredList a]
collision) of
               [] -> [[Stored a]]
cont
               [Stored a]
xis -> [Stored a]
xis [Stored a] -> [[Stored a]] -> [[Stored a]]
forall a. a -> [a] -> [a]
: [[Stored a]]
cont

        | Bool
otherwise = case List a -> Maybe (Stored a)
forall a. List a -> Maybe (Stored a)
listItem (StoredList a -> List a
forall a. Stored a -> a
fromStored StoredList a
x) of
                           Maybe (Stored a)
Nothing -> Set (StoredList a) -> [StoredList a] -> [[Stored a]]
helperSelect Set (StoredList a)
rs ([StoredList a] -> [[Stored a]]) -> [StoredList a] -> [[Stored a]]
forall a b. (a -> b) -> a -> b
$ List a -> [StoredList a]
forall a. List a -> [StoredList a]
listPrev (StoredList a -> List a
forall a. Stored a -> a
fromStored StoredList a
x) [StoredList a] -> [StoredList a] -> [StoredList a]
forall a. [a] -> [a] -> [a]
++ [StoredList a]
xs
                           Just Stored a
xi -> [Stored a
xi] [Stored a] -> [[Stored a]] -> [[Stored a]]
forall a. a -> [a] -> [a]
: (Set (StoredList a) -> [StoredList a] -> [[Stored a]]
helperSelect Set (StoredList a)
rs ([StoredList a] -> [[Stored a]]) -> [StoredList a] -> [[Stored a]]
forall a b. (a -> b) -> a -> b
$ List a -> [StoredList a]
forall a. List a -> [StoredList a]
listPrev (StoredList a -> List a
forall a. Stored a -> a
fromStored StoredList a
x) [StoredList a] -> [StoredList a] -> [StoredList a]
forall a. [a] -> [a] -> [a]
++ [StoredList a]
xs)

    filterRemoved :: S.Set (StoredList a) -> [StoredList a] -> [StoredList a]
    filterRemoved :: Set (StoredList a) -> [StoredList a] -> [StoredList a]
filterRemoved Set (StoredList a)
rs = (StoredList a -> Bool) -> [StoredList a] -> [StoredList a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Set (StoredList a) -> Bool
forall a. Set a -> Bool
S.null (Set (StoredList a) -> Bool)
-> (StoredList a -> Set (StoredList a)) -> StoredList a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (StoredList a) -> Set (StoredList a) -> Set (StoredList a)
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set (StoredList a)
rs (Set (StoredList a) -> Set (StoredList a))
-> (StoredList a -> Set (StoredList a))
-> StoredList a
-> Set (StoredList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StoredList a] -> Set (StoredList a)
forall a. Storable a => [Stored a] -> Set (Stored a)
ancestors ([StoredList a] -> Set (StoredList a))
-> (StoredList a -> [StoredList a])
-> StoredList a
-> Set (StoredList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoredList a -> [StoredList a] -> [StoredList a]
forall a. a -> [a] -> [a]
:[]))

fromSList :: Mergeable a => StoredList (Component a) -> [a]
fromSList :: forall a. Mergeable a => StoredList (Component a) -> [a]
fromSList = ([Stored (Component a)] -> a) -> [[Stored (Component a)]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [Stored (Component a)] -> a
forall a. Mergeable a => [Stored (Component a)] -> a
merge ([[Stored (Component a)]] -> [a])
-> (Stored' Identity (List (Component a))
    -> [[Stored (Component a)]])
-> Stored' Identity (List (Component a))
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored' Identity (List (Component a)) -> [[Stored (Component a)]]
forall a. Storable a => StoredList a -> [[Stored a]]
groupsFromSLists

storedFromSList :: (Mergeable a, Storable a) => StoredList (Component a) -> IO [Stored a]
storedFromSList :: forall a.
(Mergeable a, Storable a) =>
StoredList (Component a) -> IO [Stored a]
storedFromSList = ([Stored (Component a)] -> IO (Stored a))
-> [[Stored (Component a)]] -> IO [Stored a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Stored (Component a)] -> IO (Stored a)
forall a.
(Mergeable a, Storable a) =>
[Stored (Component a)] -> IO (Stored a)
storeMerge ([[Stored (Component a)]] -> IO [Stored a])
-> (Stored' Identity (List (Component a))
    -> [[Stored (Component a)]])
-> Stored' Identity (List (Component a))
-> IO [Stored a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored' Identity (List (Component a)) -> [[Stored (Component a)]]
forall a. Storable a => StoredList a -> [[Stored a]]
groupsFromSLists

slistAdd :: Storable a => a -> StoredList a -> IO (StoredList a)
slistAdd :: forall a. Storable a => a -> StoredList a -> IO (StoredList a)
slistAdd a
x prev :: StoredList a
prev@(Stored (Ref Storage
st RefDigest
_) List a
_) = do
    Stored a
sx <- Storage -> a -> IO (Stored a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Storage -> a -> m (Stored a)
wrappedStore Storage
st a
x
    Stored a -> StoredList a -> IO (StoredList a)
forall a.
Storable a =>
Stored a -> StoredList a -> IO (StoredList a)
slistAddS Stored a
sx StoredList a
prev

slistAddS :: Storable a => Stored a -> StoredList a -> IO (StoredList a)
slistAddS :: forall a.
Storable a =>
Stored a -> StoredList a -> IO (StoredList a)
slistAddS Stored a
sx prev :: StoredList a
prev@(Stored (Ref Storage
st RefDigest
_) List a
_) = Storage -> List a -> IO (StoredList a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Storage -> a -> m (Stored a)
wrappedStore Storage
st ([StoredList a]
-> Maybe (Stored a) -> Maybe (StoredList a) -> List a
forall a.
[StoredList a]
-> Maybe (Stored a) -> Maybe (StoredList a) -> List a
ListItem [StoredList a
prev] (Stored a -> Maybe (Stored a)
forall a. a -> Maybe a
Just Stored a
sx) Maybe (StoredList a)
forall a. Maybe a
Nothing)

{- TODO
slistInsert :: Storable a => Stored a -> a -> StoredList a -> IO (StoredList a)
slistInsert after x prev@(Stored (Ref st _) _) = do
    sx <- wrappedStore st x
    slistInsertS after sx prev

slistInsertS :: Storable a => Stored a -> Stored a -> StoredList a -> IO (StoredList a)
slistInsertS after sx prev@(Stored (Ref st _) _) = wrappedStore st $ ListItem Nothing (findSListRef after prev) (Just sx) prev
-}

slistRemove :: Storable a => Stored a -> StoredList a -> IO (StoredList a)
slistRemove :: forall a.
Storable a =>
Stored a -> StoredList a -> IO (StoredList a)
slistRemove Stored a
rm prev :: StoredList a
prev@(Stored (Ref Storage
st RefDigest
_) List a
_) = Storage -> List a -> IO (StoredList a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Storage -> a -> m (Stored a)
wrappedStore Storage
st (List a -> IO (StoredList a)) -> List a -> IO (StoredList a)
forall a b. (a -> b) -> a -> b
$ [StoredList a]
-> Maybe (Stored a) -> Maybe (StoredList a) -> List a
forall a.
[StoredList a]
-> Maybe (Stored a) -> Maybe (StoredList a) -> List a
ListItem [StoredList a
prev] Maybe (Stored a)
forall a. Maybe a
Nothing (Stored a -> StoredList a -> Maybe (StoredList a)
forall a. Stored a -> StoredList a -> Maybe (StoredList a)
findSListRef Stored a
rm StoredList a
prev)

slistReplace :: Storable a => Stored a -> a -> StoredList a -> IO (StoredList a)
slistReplace :: forall a.
Storable a =>
Stored a -> a -> StoredList a -> IO (StoredList a)
slistReplace Stored a
rm a
x prev :: StoredList a
prev@(Stored (Ref Storage
st RefDigest
_) List a
_) = do
    Stored a
sx <- Storage -> a -> IO (Stored a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Storage -> a -> m (Stored a)
wrappedStore Storage
st a
x
    Stored a -> Stored a -> StoredList a -> IO (StoredList a)
forall a.
Storable a =>
Stored a -> Stored a -> StoredList a -> IO (StoredList a)
slistReplaceS Stored a
rm Stored a
sx StoredList a
prev

slistReplaceS :: Storable a => Stored a -> Stored a -> StoredList a -> IO (StoredList a)
slistReplaceS :: forall a.
Storable a =>
Stored a -> Stored a -> StoredList a -> IO (StoredList a)
slistReplaceS Stored a
rm Stored a
sx prev :: StoredList a
prev@(Stored (Ref Storage
st RefDigest
_) List a
_) = Storage -> List a -> IO (StoredList a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Storage -> a -> m (Stored a)
wrappedStore Storage
st (List a -> IO (StoredList a)) -> List a -> IO (StoredList a)
forall a b. (a -> b) -> a -> b
$ [StoredList a]
-> Maybe (Stored a) -> Maybe (StoredList a) -> List a
forall a.
[StoredList a]
-> Maybe (Stored a) -> Maybe (StoredList a) -> List a
ListItem [StoredList a
prev] (Stored a -> Maybe (Stored a)
forall a. a -> Maybe a
Just Stored a
sx) (Stored a -> StoredList a -> Maybe (StoredList a)
forall a. Stored a -> StoredList a -> Maybe (StoredList a)
findSListRef Stored a
rm StoredList a
prev)

findSListRef :: Stored a -> StoredList a -> Maybe (StoredList a)
findSListRef :: forall a. Stored a -> StoredList a -> Maybe (StoredList a)
findSListRef Stored a
_ (Stored Ref
_ List a
ListNil) = Maybe (Stored' Identity (List a))
forall a. Maybe a
Nothing
findSListRef Stored a
x Stored' Identity (List a)
cur | List a -> Maybe (Stored a)
forall a. List a -> Maybe (Stored a)
listItem (Stored' Identity (List a) -> List a
forall a. Stored a -> a
fromStored Stored' Identity (List a)
cur) Maybe (Stored a) -> Maybe (Stored a) -> Bool
forall a. Eq a => a -> a -> Bool
== Stored a -> Maybe (Stored a)
forall a. a -> Maybe a
Just Stored a
x = Stored' Identity (List a) -> Maybe (Stored' Identity (List a))
forall a. a -> Maybe a
Just Stored' Identity (List a)
cur
                   | Bool
otherwise                           = [Stored' Identity (List a)] -> Maybe (Stored' Identity (List a))
forall a. [a] -> Maybe a
listToMaybe ([Stored' Identity (List a)] -> Maybe (Stored' Identity (List a)))
-> [Stored' Identity (List a)] -> Maybe (Stored' Identity (List a))
forall a b. (a -> b) -> a -> b
$ [Maybe (Stored' Identity (List a))] -> [Stored' Identity (List a)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Stored' Identity (List a))]
 -> [Stored' Identity (List a)])
-> [Maybe (Stored' Identity (List a))]
-> [Stored' Identity (List a)]
forall a b. (a -> b) -> a -> b
$ (Stored' Identity (List a) -> Maybe (Stored' Identity (List a)))
-> [Stored' Identity (List a)]
-> [Maybe (Stored' Identity (List a))]
forall a b. (a -> b) -> [a] -> [b]
map (Stored a
-> Stored' Identity (List a) -> Maybe (Stored' Identity (List a))
forall a. Stored a -> StoredList a -> Maybe (StoredList a)
findSListRef Stored a
x) ([Stored' Identity (List a)]
 -> [Maybe (Stored' Identity (List a))])
-> [Stored' Identity (List a)]
-> [Maybe (Stored' Identity (List a))]
forall a b. (a -> b) -> a -> b
$ List a -> [Stored' Identity (List a)]
forall a. List a -> [StoredList a]
listPrev (List a -> [Stored' Identity (List a)])
-> List a -> [Stored' Identity (List a)]
forall a b. (a -> b) -> a -> b
$ Stored' Identity (List a) -> List a
forall a. Stored a -> a
fromStored Stored' Identity (List a)
cur

{- TODO
mapFromSList :: Storable a => StoredList a -> Map RefDigest (Stored a)
mapFromSList list = helper list M.empty
    where helper :: Storable a => StoredList a -> Map RefDigest (Stored a) -> Map RefDigest (Stored a)
          helper (Stored _ ListNil) cur = cur
          helper (Stored _ (ListItem (Just rref) _ (Just x) rest)) cur =
              let rxref = case load rref of
                               ListItem _ _ (Just rx) _  -> sameType rx x $ storedRef rx
                               _ -> error "mapFromSList: malformed list"
               in helper rest $ case M.lookup (refDigest $ storedRef x) cur of
                                     Nothing -> M.insert (refDigest rxref) x cur
                                     Just x' -> M.insert (refDigest rxref) x' cur
          helper (Stored _ (ListItem _ _ _ rest)) cur = helper rest cur
          sameType :: a -> a -> b -> b
          sameType _ _ x = x

updateOld :: Map RefDigest (Stored a) -> Stored a -> Stored a
updateOld m x = fromMaybe x $ M.lookup (refDigest $ storedRef x) m


data StoreUpdate a = StoreKeep
                   | StoreReplace a
                   | StoreRemove

withStoredListItem :: (Storable a) => (a -> Bool) -> StoredList a -> (a -> IO (StoreUpdate a)) -> IO (StoredList a)
withStoredListItem p list f = withStoredListItemS (p . fromStored) list (suMap (wrappedStore $ storedStorage list) <=< f . fromStored)
    where suMap :: Monad m => (a -> m b) -> StoreUpdate a -> m (StoreUpdate b)
          suMap _ StoreKeep = return StoreKeep
          suMap g (StoreReplace x) = return . StoreReplace =<< g x
          suMap _ StoreRemove = return StoreRemove

withStoredListItemS :: (Storable a) => (Stored a -> Bool) -> StoredList a -> (Stored a -> IO (StoreUpdate (Stored a))) -> IO (StoredList a)
withStoredListItemS p list f = do
    case find p $ storedFromSList list of
         Just sx -> f sx >>= \case StoreKeep -> return list
                                   StoreReplace nx -> slistReplaceS sx nx list
                                   StoreRemove -> slistRemove sx list
         Nothing -> return list
-}