hblock-0.1.0.0: Data/Indexation/NormalIx.hs
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Indexation.NormalIx
( SimpleIx(..)
, Indexed(..)
, createIndexed
, withUnique1
, withUnique2
, withIndex1
, withIndex2
, withIndex3
, withIndex4
, withFilters
, insertGetIx
, insert
, deleteIndex
, deleteU1
, deleteU2
, getU1
, getU2
, getI1
, getI2
, getI3
, getI4
, getFilter
, adjust
, adjustWithU1
, adjustWithU2
, update
, updateWithU1
, updateWithU2
) where
import Data.HBlock (HBlock)
import qualified Data.HBlock as HB
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import Data.Vector (Vector, (!?))
import qualified Data.Vector as V
import Data.SafeCopy
import Data.Hashable
import qualified Data.Foldable as Fold
-- import Data.Indexation.IxData (IxData(ixDataPos, ixData))
import Data.Maybe (fromMaybe)
data Indexed a u1 u2 i1 i2 i3 i4
= Indexed !(HBlock a)
-- ^ Where all the data is
!(Maybe (IndexU a u1 u2))
-- ^ Unique indexation structures
!(Maybe (IndexI a i1 i2 i3 i4))
-- ^ Indexation structures
!(Vector (a -> Bool))
-- ^ Filters (i.e. >= 30)
!(Vector IntSet)
-- ^ Filters results
-- | IndexCore is the index structures for a given data
data IndexU a u1 u2
= IxHasU1 !(HashMap u1 Int) !(a -> u1)
| IxHasU2 !(HashMap u1 Int) !(a -> u1)
!(HashMap u2 Int) !(a -> u2)
data IndexI a i1 i2 i3 i4
= IxHasI1 !(HashMap i1 IntSet) !(a -> i1)
| IxHasI2 !(HashMap i1 IntSet) !(a -> i1)
!(HashMap i2 IntSet) !(a -> i2)
| IxHasI3 !(HashMap i1 IntSet) !(a -> i1)
!(HashMap i2 IntSet) !(a -> i2)
!(HashMap i3 IntSet) !(a -> i3)
| IxHasI4 !(HashMap i1 IntSet) !(a -> i1)
!(HashMap i2 IntSet) !(a -> i2)
!(HashMap i3 IntSet) !(a -> i3)
!(HashMap i4 IntSet) !(a -> i4)
-- *
-- * Creation functions
-- *
class SimpleIx a where
-- | Creates your indexed dataype
type U1 a
type U2 a
type I1 a
type I2 a
type I3 a
type I4 a
create :: Indexed a (U1 a) (U2 a) (I1 a) (I2 a) (I3 a) (I4 a)
defSlots :: Int
defSlots = 4096
defBlockLen :: Int
defBlockLen = 4096
-- | createIndexed is a helper function to create the base Indexed datatype
-- it is used in the "createdUxIx" functions to avoid repetition
createIndexed :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4)
=> a -> Indexed a u1 u2 i1 i2 i3 i4
createIndexed e = Indexed (HB.empty defSlots defBlockLen e)
Nothing Nothing V.empty V.empty
withUnique1 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> (a -> u1)
-> Indexed a u1 u2 i1 i2 i3 i4
withUnique1 i@(Indexed v uis iis vf vs) f =
case uis of
Nothing -> Indexed v (Just $ IxHasU1 HM.empty f) iis vf vs
_ -> i
withUnique2 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> (a -> u2)
-> Indexed a u1 u2 i1 i2 i3 i4
withUnique2 i@(Indexed v uis iis vf vs) f =
case uis of
Just (IxHasU1 m1 f1) ->
Indexed v (Just $ IxHasU2 m1 f1 HM.empty f) iis vf vs
_ -> i
withIndex1 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> (a -> i1)
-> Indexed a u1 u2 i1 i2 i3 i4
withIndex1 i@(Indexed v uis iis vf vs) f =
case iis of
Nothing -> Indexed v uis (Just $ IxHasI1 HM.empty f) vf vs
_ -> i
withIndex2 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> (a -> i2)
-> Indexed a u1 u2 i1 i2 i3 i4
withIndex2 i@(Indexed v uis iis vf vs) f =
case iis of
Just (IxHasI1 m1 f1) ->
let niis = Just $ IxHasI2 m1 f1 HM.empty f in
Indexed v uis niis vf vs
_ -> i
withIndex3 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> (a -> i3)
-> Indexed a u1 u2 i1 i2 i3 i4
withIndex3 i@(Indexed v uis iis vf vs) f =
case iis of
Just (IxHasI2 m1 f1 m2 f2) ->
let niis = Just $ IxHasI3 m1 f1 m2 f2 HM.empty f in
Indexed v uis niis vf vs
_ -> i
withIndex4 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> (a -> i4)
-> Indexed a u1 u2 i1 i2 i3 i4
withIndex4 i@(Indexed v uis iis vf vs) f =
case iis of
Just (IxHasI3 m1 f1 m2 f2 m3 f3) ->
let niis = Just $ IxHasI4 m1 f1 m2 f2 m3 f3 HM.empty f in
Indexed v uis niis vf vs
_ -> i
withFilters :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> [(a -> Bool)]
-> Indexed a u1 u2 i1 i2 i3 i4
withFilters (Indexed v uis iis _ _) lst =
Indexed v uis iis flst vlst
where
flst = V.fromList lst
vlst = V.replicate (V.length flst) IS.empty
-- *
-- * Insertion functions
-- *
insertGetIx :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> a
-> (Int, Indexed a u1 u2 i1 i2 i3 i4)
insertGetIx (Indexed hb uis iis vf vi) item =
(pos, Indexed newhb newuis newiis vf newvi)
where
(pos, newhb) = HB.insertGetIx item hb
newuis =
case uis of
Nothing -> Nothing
Just (IxHasU1 m1 f1) -> Just $
IxHasU1 (HM.insert (f1 item) pos m1) f1
Just (IxHasU2 m1 f1 m2 f2) -> Just $
IxHasU2 (HM.insert (f1 item) pos m1) f1
(HM.insert (f2 item) pos m2) f2
newiis =
case iis of
Nothing -> Nothing
Just (IxHasI1 m1 f1) -> Just $
IxHasI1 (HM.adjust (IS.insert pos) (f1 item) m1) f1
Just (IxHasI2 m1 f1 m2 f2) -> Just $
IxHasI2 (HM.adjust (IS.insert pos) (f1 item) m1) f1
(HM.adjust (IS.insert pos) (f2 item) m2) f2
Just (IxHasI3 m1 f1 m2 f2 m3 f3) -> Just $
IxHasI3 (HM.adjust (IS.insert pos) (f1 item) m1) f1
(HM.adjust (IS.insert pos) (f2 item) m2) f2
(HM.adjust (IS.insert pos) (f3 item) m3) f3
Just (IxHasI4 m1 f1 m2 f2 m3 f3 m4 f4) -> Just $
IxHasI4 (HM.adjust (IS.insert pos) (f1 item) m1) f1
(HM.adjust (IS.insert pos) (f2 item) m2) f2
(HM.adjust (IS.insert pos) (f3 item) m3) f3
(HM.adjust (IS.insert pos) (f4 item) m4) f4
newvi = V.imap fvi vi
-- check if the filter applies to this element, if it applies insert
-- the element index into the intset
fvi i e = if V.unsafeIndex vf i $ item then IS.insert pos e else e
{-# INLINABLE insertGetIx #-}
insert :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> a -> Indexed a u1 u2 i1 i2 i3 i4
insert i item = snd $ insertGetIx i item
{-# INLINE insert #-}
-- *
-- * Deletion functions
-- *
deleteIndex :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> Int -> Indexed a u1 u2 i1 i2 i3 i4
deleteIndex (Indexed hb uis iis vf vi) ix =
Indexed (HB.delete ix hb) uis iis vf vi
{-# INLINE deleteIndex #-}
-- ^ TODO: delete from the indices and vi ?
deleteU1 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> u1 -> Maybe (Indexed a u1 u2 i1 i2 i3 i4)
deleteU1 i@(Indexed hb uis _ _ _) u1 = do
u <- uis
pos <- f u
return $ deleteIndex i pos
where
f (IxHasU1 m _) = HM.lookup u1 m
f (IxHasU2 m _ _ _) = HM.lookup u1 m
deleteU2 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> u2 -> Maybe (Indexed a u1 u2 i1 i2 i3 i4)
deleteU2 i@(Indexed hb uis _ _ _) u2 = do
u <- uis
pos <- f u
return $ deleteIndex i pos
where
f (IxHasU1 _ _) = Nothing
f (IxHasU2 _ _ m _) = HM.lookup u2 m
-- deleteIxData
{-
delete :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> a -> Indexed a u1 u2 i1 i2 i3 i4
delete (Indexed hb uis iis vf vi) a =
-}
-- *
-- * Accessor (getters) functions
-- *
getU1 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> u1 -> Maybe a
getU1 (Indexed hb uis _ _ _) u1 = do
u <- uis
pos <- f u
HB.getPos hb pos
where
f (IxHasU1 m _) = HM.lookup u1 m
f (IxHasU2 m _ _ _) = HM.lookup u1 m
{-# INLINABLE getU1 #-}
getU2 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> u2 -> Maybe a
getU2 (Indexed hb uis _ _ _) u2 = do
u <- uis
pos <- f u
HB.getPos hb pos
where
f (IxHasU1 _ _) = Nothing
f (IxHasU2 _ _ m _) = HM.lookup u2 m
{-# INLINABLE getU2 #-}
getI1 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> i1 -> Maybe (HBlock a)
getI1 (Indexed hb _ iis _ _) i = do
iis' <- iis
set <- f iis'
return $ HB.getSet hb set
where
f (IxHasI1 m _) = HM.lookup i m
f (IxHasI2 m _ _ _) = HM.lookup i m
f (IxHasI3 m _ _ _ _ _) = HM.lookup i m
f (IxHasI4 m _ _ _ _ _ _ _) = HM.lookup i m
{-# INLINABLE getI1 #-}
getI2 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> i2 -> Maybe (HBlock a)
getI2 (Indexed hb _ iis _ _) i = do
iis' <- iis
set <- f iis'
return $ HB.getSet hb set
where
f (IxHasI2 _ _ m _) = HM.lookup i m
f (IxHasI3 _ _ m _ _ _) = HM.lookup i m
f (IxHasI4 _ _ m _ _ _ _ _) = HM.lookup i m
f _ = Nothing
{-# INLINABLE getI2 #-}
getI3 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> i3 -> Maybe (HBlock a)
getI3 (Indexed hb _ iis _ _) i = do
iis' <- iis
set <- f iis'
return $ HB.getSet hb set
where
f (IxHasI3 _ _ _ _ m _) = HM.lookup i m
f (IxHasI4 _ _ _ _ m _ _ _) = HM.lookup i m
f _ = Nothing
{-# INLINABLE getI3 #-}
getI4 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> i4 -> Maybe (HBlock a)
getI4 (Indexed hb _ iis _ _) i = do
iis' <- iis
set <- f iis'
return $ HB.getSet hb set
where
f (IxHasI4 _ _ _ _ _ _ m _) = HM.lookup i m
f _ = Nothing
{-# INLINABLE getI4 #-}
getFilter :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> Int -> Maybe (HBlock a)
getFilter (Indexed hb _ _ _ vi) filterPos = do
set <- vi !? filterPos
return $ HB.getSet hb set
{-# INLINABLE getFilter #-}
-- *
-- * Setter functions
-- *
-- | helper function, updates the hash of a unique index
_updateUHash :: (Eq u, Hashable u) => HashMap u Int -> Int -> u -> u
-> HashMap u Int
_updateUHash m val old new = HM.insert new val $ HM.delete old m
_updateIHash :: (Eq u, Hashable u) => HashMap u IntSet -> Int -> u -> u
-> HashMap u IntSet
_updateIHash m val old new =
HM.insertWith insSet new valSet $ HM.adjust (IS.delete val) old m
where
insSet _ o = IS.insert val o
valSet = IS.singleton val
-- | helper function, updates the unique indices
_updateU :: (Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2)
=> Maybe (IndexU a u1 u2) -> Int -> a -> a -> Maybe (IndexU a u1 u2)
_updateU (Just (IxHasU1 m f)) val old new =
Just $ IxHasU1 (_updateUHash m val (f old) (f new)) f
_updateU (Just (IxHasU2 m1 f1 m2 f2)) val old new =
Just $ IxHasU2 (_updateUHash m1 val (f1 old) (f1 new)) f1
(_updateUHash m2 val (f2 old) (f2 new)) f2
_updateU Nothing _ _ _ = Nothing
-- | helper function, updates the normal indices
_updateI :: ( Eq a
, Eq i1, Hashable i1, Eq i2, Hashable i2
, Eq i3, Hashable i3, Eq i4, Hashable i4)
=> Maybe (IndexI a i1 i2 i3 i4) -> Int -> a -> a
-> Maybe (IndexI a i1 i2 i3 i4)
_updateI (Just (IxHasI1 m f)) val old new =
Just $ IxHasI1 (_updateIHash m val (f old) (f new)) f
_updateI (Just (IxHasI2 m1 f1 m2 f2)) val old new =
Just $ IxHasI2 (_updateIHash m1 val (f1 old) (f1 new)) f1
(_updateIHash m2 val (f2 old) (f2 new)) f2
_updateI (Just (IxHasI3 m1 f1 m2 f2 m3 f3)) val old new =
Just $ IxHasI3 (_updateIHash m1 val (f1 old) (f1 new)) f1
(_updateIHash m2 val (f2 old) (f2 new)) f2
(_updateIHash m3 val (f3 old) (f3 new)) f3
_updateI (Just (IxHasI4 m1 f1 m2 f2 m3 f3 m4 f4)) val old new =
Just $ IxHasI4 (_updateIHash m1 val (f1 old) (f1 new)) f1
(_updateIHash m2 val (f2 old) (f2 new)) f2
(_updateIHash m3 val (f3 old) (f3 new)) f3
(_updateIHash m4 val (f4 old) (f4 new)) f4
_updateI Nothing _ _ _ = Nothing
-- | helper function, updates the normal indices
_updateF :: Vector (a -> Bool) -> Vector IntSet -> Int -> a -> a
-> Vector IntSet
_updateF vf v value old new = V.imap applyF vf
-- map the vf, apply the function to the old and the new, if diff, change the v
-- because it is faster to check for indexation in a vector than to check
-- membership in a intset
where
applyF pos f = let f1 = f old
f2 = f new
iset = V.unsafeIndex v pos
in if f1 == f2
then iset
else if f2 then IS.insert value iset
else IS.delete value iset
adjust :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> Int -> (a -> a)
-> Maybe (Indexed a u1 u2 i1 i2 i3 i4)
adjust i@(Indexed hb ius iis vf vi) pos f = do
e <- HB.getPos hb pos
let newe = f e
return $ Indexed (HB.update newe pos hb)
(_updateU ius pos e newe)
(_updateI iis pos e newe)
vf (_updateF vf vi pos e newe)
{-# INLINABLE adjust #-}
adjustWithU1 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> u1 -> (a -> a)
-> Maybe (Indexed a u1 u2 i1 i2 i3 i4)
adjustWithU1 i@(Indexed hb uis iis vf vi) u1 af = do
u <- uis
pos <- f u
e <- HB.getPos hb pos
let newe = af e
return $ Indexed (HB.update newe pos hb)
(_updateU uis pos e newe)
(_updateI iis pos e newe)
vf (_updateF vf vi pos e newe)
where
f (IxHasU1 m _) = HM.lookup u1 m
f (IxHasU2 m _ _ _) = HM.lookup u1 m
{-# INLINABLE adjustWithU1 #-}
adjustWithU2 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> u2 -> (a -> a)
-> Maybe (Indexed a u1 u2 i1 i2 i3 i4)
adjustWithU2 i@(Indexed hb uis iis vf vi) u2 af = do
u <- uis
pos <- f u
e <- HB.getPos hb pos
let newe = af e
return $ Indexed (HB.update newe pos hb)
(_updateU uis pos e newe)
(_updateI iis pos e newe)
vf (_updateF vf vi pos e newe)
where
f (IxHasU1 _ _) = Nothing
f (IxHasU2 _ _ m _) = HM.lookup u2 m
{-# INLINABLE adjustWithU2 #-}
update :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> Int -> a
-> Maybe (Indexed a u1 u2 i1 i2 i3 i4)
update i p a = adjust i p (const a)
{-# INLINABLE update #-}
updateWithU1 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> u1 -> a
-> Maybe (Indexed a u1 u2 i1 i2 i3 i4)
updateWithU1 i u1 a = adjustWithU1 i u1 (const a)
{-# INLINABLE updateWithU1 #-}
updateWithU2 :: ( Eq a, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
)
=> Indexed a u1 u2 i1 i2 i3 i4 -> u2 -> a
-> Maybe (Indexed a u1 u2 i1 i2 i3 i4)
updateWithU2 i u2 a = adjustWithU2 i u2 (const a)
{-# INLINABLE updateWithU2 #-}
instance ( SafeCopy a, Eq a, SimpleIx a
, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3, Hashable i3
, Eq i4, Hashable i4
, u1 ~ U1 a, u2 ~ U2 a, i1 ~ I1 a, i2 ~ I2 a, i3 ~ I3 a, i4 ~ I4 a
) => SafeCopy (Indexed a u1 u2 i1 i2 i3 i4) where
version = 0
kind = base
putCopy (Indexed hb _ _ _ _) = contain $ safePut hb
getCopy = contain $ fmap withData safeGet
where
withData :: (SafeCopy a, Eq a, SimpleIx a
, Eq u1, Hashable u1, Eq u2, Hashable u2
, Eq i1, Hashable i1, Eq i2, Hashable i2, Eq i3
, Hashable i3, Eq i4, Hashable i4
, u1 ~ U1 a, u2 ~ U2 a, i1 ~ I1 a, i2 ~ I2 a, i3 ~ I3 a
, i4 ~ I4 a) => HBlock a -> Indexed a u1 u2 i1 i2 i3 i4
withData h = Fold.foldl insert create h