module Data.SimpleIndex
(
Indexed
, create1
, create2
, create3
, create4
, create5
, create6
, SimpleIx(..)
, ixInsert
, ixDelete
, ixUpdate
, ixRead1
, ixRead2
, ixRead3
, ixRead4
, ixRead5
, ixRead6
)
where
import Prelude
import Data.Foldable
import qualified Data.Foldable as Fold
import Data.Sequence (Seq, (|>), (><))
import qualified Data.Sequence as Seq
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as HM
import Data.SafeCopy
import Data.Hashable
_ixInsertIx f h pos u = HM.insert (f u) pos h
_ixInsertData u ux baseData constructor =
(pos, constructor newBase)
where
newBase = baseData |> u
pos = Seq.length baseData
_ixIt f hix u ux (pos, c) = (pos, c (_ixInsertIx f hix pos u) f)
_getIx = snd
_ixInsertData1 u ux c bd hix1 f1 =
_ixIt f1 hix1 u ux $
_ixInsertData u ux bd c
_ixInsertData2 u ux c b hix1 hix2 f1 f2 =
_ixIt f2 hix2 u ux $ _ixInsertData1 u ux c b hix1 f1
_ixInsertData3 u ux c b hix1 hix2 hix3 f1 f2 f3 =
_ixIt f3 hix3 u ux $ _ixInsertData2 u ux c b hix1 hix2 f1 f2
_ixInsertData4 u ux c b hix1 hix2 hix3 hix4 f1 f2 f3 f4 =
_ixIt f4 hix4 u ux $ _ixInsertData3 u ux c b hix1 hix2 hix3 f1 f2 f3
_ixInsertData5 u ux c b hix1 hix2 hix3 hix4 hix5 f1 f2 f3 f4 f5 =
_ixIt f5 hix5 u ux $ _ixInsertData4 u ux c b hix1 hix2 hix3 hix4 f1 f2 f3 f4
_ixInsertData6 u ux c b hix1 hix2 hix3 hix4 hix5 hix6 f1 f2 f3 f4 f5 f6=
_ixIt f6 hix6 u ux $ _ixInsertData5 u ux c b hix1 hix2 hix3 hix4 hix5 f1 f2 f3 f4 f5
_ixUpdateIx getIndex h pos old new =
HM.insert (getIndex new) pos $ HM.delete (getIndex old) h
_ixUpdateData ux constructor base hix uid updateF =
fmap genTuple $ HM.lookup uid hix
where
old' pos = Seq.index base pos
new' pos = updateF (old' pos)
newBase pos = Seq.update pos (new' pos) base
genTuple pos = (pos, old' pos, new' pos, constructor (newBase pos))
_ixUp f hix ux (pos, old, new, c) =
(pos, old, new, c (_ixUpdateIx f hix pos old new) f)
_getUp u t = case t of
Nothing -> u
Just (_,_,_,f) -> f
_ixUpdateData1 ux c b hix1 f1 uid f =
fmap (_ixUp f1 hix1 ux) (_ixUpdateData ux c b hix1 uid f)
_ixUpdateData2 ux c b hix1 hix2 f1 f2 uid f =
fmap (_ixUp f2 hix2 ux) (_ixUpdateData1 ux c b hix1 f1 uid f)
_ixUpdateData3 ux c b hix1 hix2 hix3 f1 f2 f3 uid f =
fmap (_ixUp f3 hix3 ux) (_ixUpdateData2 ux c b hix1 hix2 f1 f2 uid f)
_ixUpdateData4 ux c b hix1 hix2 hix3 hix4 f1 f2 f3 f4 uid f =
fmap (_ixUp f4 hix4 ux) (_ixUpdateData3 ux c b hix1 hix2 hix3 f1 f2 f3 uid f)
_ixUpdateData5 ux c b hix1 hix2 hix3 hix4 hix5 f1 f2 f3 f4 f5 uid f =
fmap (_ixUp f5 hix5 ux) (_ixUpdateData4 ux c b hix1 hix2 hix3 hix4 f1 f2 f3 f4 uid f)
_ixUpdateData6 ux c b hix1 hix2 hix3 hix4 hix5 hix6 f1 f2 f3 f4 f5 f6 uid f =
fmap (_ixUp f6 hix6 ux) (_ixUpdateData5 ux c b hix1 hix2 hix3 hix4 hix5 f1 f2 f3 f4 f5 uid f)
_ixDeleteIx getIndex h u = HM.delete (getIndex u) h
_ixDeleteData u ux constructor base = constructor newBase
where
newBase = _seqDelete u base
_seqDelete :: Eq a => a -> Seq a -> Seq a
_seqDelete item ss = left >< Seq.drop 1 right
where (left, right) = Seq.breakl (== item) ss
_ixDeleteData1 ux c b hix1 f1 u =
(_ixDeleteData u ux c b) (_ixDeleteIx f1 hix1 u) f1
_ixDeleteData2 ux c b hix1 hix2 f1 f2 u =
(_ixDeleteData1 ux c b hix1 f1 u) (_ixDeleteIx f2 hix2 u) f2
_ixDeleteData3 ux c b hix1 hix2 hix3 f1 f2 f3 u =
(_ixDeleteData2 ux c b hix1 hix2 f1 f2 u) (_ixDeleteIx f3 hix3 u) f3
_ixDeleteData4 ux c b hix1 hix2 hix3 hix4 f1 f2 f3 f4 u =
(_ixDeleteData3 ux c b hix1 hix2 hix3 f1 f2 f3 u) (_ixDeleteIx f4 hix4 u) f4
_ixDeleteData5 ux c b hix1 hix2 hix3 hix4 hix5 f1 f2 f3 f4 f5 u =
(_ixDeleteData4 ux c b hix1 hix2 hix3 hix4 f1 f2 f3 f4 u) (_ixDeleteIx f5 hix5 u) f5
_ixDeleteData6 ux c b hix1 hix2 hix3 hix4 hix5 hix6 f1 f2 f3 f4 f5 f6 u =
(_ixDeleteData5 ux c b hix1 hix2 hix3 hix4 hix5 f1 f2 f3 f4 f5 u) (_ixDeleteIx f6 hix6 u) f6
data Indexed a i1 i2 i3 i4 i5 i6
=
IxHas1 { has1Base :: Seq a
, has1Ix1 :: (HashMap i1 Int)
, has1Fetch1 :: (a -> i1)
}
| IxHas2 { has2Base :: Seq a
, has2Ix1 :: (HashMap i1 Int)
, has2Fetch1 :: (a -> i1)
, has2Ix2 :: (HashMap i2 Int)
, has2Fetch2 :: (a -> i2)
}
| IxHas3 { has3Base :: Seq a
, has3Ix1 :: (HashMap i1 Int)
, has3Fetch1 :: (a -> i1)
, has3Ix2 :: (HashMap i2 Int)
, has3Fetch2 :: (a -> i2)
, has3Ix3 :: (HashMap i3 Int)
, has3Fetch3 :: (a -> i3)
}
| IxHas4 { has4Base :: Seq a
, has4Ix1 :: (HashMap i1 Int)
, has4Fetch1 :: (a -> i1)
, has4Ix2 :: (HashMap i2 Int)
, has4Fetch2 :: (a -> i2)
, has4Ix3 :: (HashMap i3 Int)
, has4Fetch3 :: (a -> i3)
, has4Ix4 :: (HashMap i4 Int)
, has4Fetch4 :: (a -> i4)
}
| IxHas5 { has5Base :: Seq a
, has5Ix1 :: (HashMap i1 Int)
, has5Fetch1 :: (a -> i1)
, has5Ix2 :: (HashMap i2 Int)
, has5Fetch2 :: (a -> i2)
, has5Ix3 :: (HashMap i3 Int)
, has5Fetch3 :: (a -> i3)
, has5Ix4 :: (HashMap i4 Int)
, has5Fetch4 :: (a -> i4)
, has5Ix5 :: (HashMap i5 Int)
, has5Fetch5 :: (a -> i5)
}
| IxHas6 { has6Base :: Seq a
, has6Ix1 :: (HashMap i1 Int)
, has6Fetch1 :: (a -> i1)
, has6Ix2 :: (HashMap i2 Int)
, has6Fetch2 :: (a -> i2)
, has6Ix3 :: (HashMap i3 Int)
, has6Fetch3 :: (a -> i3)
, has6Ix4 :: (HashMap i4 Int)
, has6Fetch4 :: (a -> i4)
, has6Ix5 :: (HashMap i5 Int)
, has6Fetch5 :: (a -> i5)
, has6Ix6 :: (HashMap i6 Int)
, has6Fetch6 :: (a -> i6)
}
create1 :: (Eq a, Eq i1, Hashable i1)
=> (a -> i1)
-> Indexed a i1 () () () () ()
create1 f = IxHas1 Seq.empty HM.empty f
create2 f1 f2 = IxHas2 Seq.empty HM.empty f1 HM.empty f2
create3 :: (a -> i1)
-> (a -> i2)
-> (a -> i3)
-> Indexed a i1 i2 i3 () () ()
create3 f1 f2 f3 = IxHas3 Seq.empty HM.empty f1 HM.empty f2 HM.empty f3
create4 :: (a -> i1)
-> (a -> i2)
-> (a -> i3)
-> (a -> i4)
-> Indexed a i1 i2 i3 i4 () ()
create4 f1 f2 f3 f4 = IxHas4 Seq.empty HM.empty f1 HM.empty f2 HM.empty f3
HM.empty f4
create5 :: (a -> i1)
-> (a -> i2)
-> (a -> i3)
-> (a -> i4)
-> (a -> i5)
-> Indexed a i1 i2 i3 i4 i5 ()
create5 f1 f2 f3 f4 f5 = IxHas5 Seq.empty HM.empty f1 HM.empty f2 HM.empty f3
HM.empty f4 HM.empty f5
create6 :: (a -> i1)
-> (a -> i2)
-> (a -> i3)
-> (a -> i4)
-> (a -> i5)
-> (a -> i6)
-> Indexed a i1 i2 i3 i4 i5 i6
create6 f1 f2 f3 f4 f5 f6 = IxHas6 Seq.empty HM.empty f1 HM.empty f2
HM.empty f3 HM.empty f4 HM.empty f5 HM.empty f6
class SimpleIx a where
type I1 a
type I2 a
type I3 a
type I4 a
type I5 a
type I6 a
create :: Indexed a (I1 a) (I2 a) (I3 a) (I4 a) (I5 a) (I6 a)
ixInsert ::
(Eq k4, Eq k3, Eq k2, Eq k1, Eq k, Eq i6, Hashable k4,
Hashable k3, Hashable k2, Hashable k1, Hashable k, Hashable i6) =>
Indexed a k4 k3 k2 k1 k i6 -> a -> Indexed a k4 k3 k2 k1 k i6
ixInsert ux u = _getIx $
case ux of
(IxHas1 b h1 f1) -> _ixInsertData1 u ux IxHas1 b h1 f1
(IxHas2 b h1 f1 h2 f2) ->
_ixInsertData2 u ux IxHas2 b h1 h2 f1 f2
(IxHas3 b h1 f1 h2 f2 h3 f3) ->
_ixInsertData3 u ux IxHas3 b h1 h2 h3 f1 f2 f3
(IxHas4 b h1 f1 h2 f2 h3 f3 h4 f4) ->
_ixInsertData4 u ux IxHas4 b h1 h2 h3 h4 f1 f2 f3 f4
(IxHas5 b h1 f1 h2 f2 h3 f3 h4 f4 h5 f5) ->
_ixInsertData5 u ux IxHas5 b h1 h2 h3 h4 h5 f1 f2 f3 f4 f5
(IxHas6 b h1 f1 h2 f2 h3 f3 h4 f4 h5 f5 h6 f6) ->
_ixInsertData6 u ux IxHas6 b h1 h2 h3 h4 h5 h6 f1 f2 f3 f4 f5 f6
ixDelete :: (Eq a, Eq k, Eq i2, Eq i3, Eq i4, Eq i5, Eq i6, Hashable k,
Hashable i2, Hashable i3, Hashable i4, Hashable i5, Hashable i6) =>
Indexed a k i2 i3 i4 i5 i6 -> a -> Indexed a k i2 i3 i4 i5 i6
ixDelete ux u =
case ux of
(IxHas1 b h1 f1) -> _ixDeleteData1 ux IxHas1 b h1 f1 u
(IxHas2 b h1 f1 h2 f2) ->
_ixDeleteData2 ux IxHas2 b h1 h2 f1 f2 u
(IxHas3 b h1 f1 h2 f2 h3 f3) ->
_ixDeleteData3 ux IxHas3 b h1 h2 h3 f1 f2 f3 u
(IxHas4 b h1 f1 h2 f2 h3 f3 h4 f4) ->
_ixDeleteData4 ux IxHas4 b h1 h2 h3 h4 f1 f2 f3 f4 u
(IxHas5 b h1 f1 h2 f2 h3 f3 h4 f4 h5 f5) ->
_ixDeleteData5 ux IxHas5 b h1 h2 h3 h4 h5 f1 f2 f3 f4 f5 u
(IxHas6 b h1 f1 h2 f2 h3 f3 h4 f4 h5 f5 h6 f6) ->
_ixDeleteData6 ux IxHas6 b h1 h2 h3 h4 h5 h6 f1 f2 f3 f4 f5 f6 u
ixUpdate :: (Eq k, Eq i2, Eq i3, Eq i4, Eq i5, Eq i6, Hashable k,
Hashable i2, Hashable i3, Hashable i4, Hashable i5, Hashable i6) =>
Indexed a k i2 i3 i4 i5 i6
-> k -> (a -> a) -> Maybe (Int, a, a, Indexed a k i2 i3 i4 i5 i6)
ixUpdate ux uid f =
case ux of
(IxHas1 b h1 f1) -> _ixUpdateData1 ux IxHas1 b h1 f1 uid f
(IxHas2 b h1 f1 h2 f2) ->
_ixUpdateData2 ux IxHas2 b h1 h2 f1 f2 uid f
(IxHas3 b h1 f1 h2 f2 h3 f3) ->
_ixUpdateData3 ux IxHas3 b h1 h2 h3 f1 f2 f3 uid f
(IxHas4 b h1 f1 h2 f2 h3 f3 h4 f4) ->
_ixUpdateData4 ux IxHas4 b h1 h2 h3 h4 f1 f2 f3 f4 uid f
(IxHas5 b h1 f1 h2 f2 h3 f3 h4 f4 h5 f5) ->
_ixUpdateData5 ux IxHas5 b h1 h2 h3 h4 h5 f1 f2 f3 f4 f5 uid f
(IxHas6 b h1 f1 h2 f2 h3 f3 h4 f4 h5 f5 h6 f6) ->
_ixUpdateData6 ux IxHas6 b h1 h2 h3 h4 h5 h6 f1 f2 f3 f4 f5 f6 uid f
_read :: (Eq k, Hashable k)
=> (Indexed b t1 t2 t3 t4 t5 t6 -> Maybe (HashMap k Int))
-> k -> Indexed b t1 t2 t3 t4 t5 t6 -> Maybe b
_read f b ux = do
ixHashMap <- f ux
index <- HM.lookup b ixHashMap
return $ Seq.index (_ixData ux) index
ixRead1 :: (Eq b, Hashable b) => b -> Indexed a b t2 t3 t4 t5 t6 -> Maybe a
ixRead1 = _read _getIx1
ixRead2 :: (Eq b, Hashable b) => b -> Indexed a t1 b t3 t4 t5 t6 -> Maybe a
ixRead2 = _read _getIx2
ixRead3 :: (Eq b, Hashable b) => b -> Indexed a t1 t2 b t4 t5 t6 -> Maybe a
ixRead3 = _read _getIx3
ixRead4 :: (Eq b, Hashable b) => b -> Indexed a t1 t2 t3 b t5 t6 -> Maybe a
ixRead4 = _read _getIx4
ixRead5 :: (Eq b, Hashable b) => b -> Indexed a t1 t2 t3 t4 b t6 -> Maybe a
ixRead5 = _read _getIx5
ixRead6 :: (Eq b, Hashable b) => b -> Indexed a t1 t2 t3 t4 t5 b -> Maybe a
ixRead6 = _read _getIx6
_ixData :: Indexed a t1 t2 t3 t4 t5 t6 -> Seq a
_ixData ux =
case ux of
(IxHas1 b _ _) -> b
(IxHas2 b _ _ _ _) -> b
(IxHas3 b _ _ _ _ _ _) -> b
(IxHas4 b _ _ _ _ _ _ _ _) -> b
(IxHas5 b _ _ _ _ _ _ _ _ _ _) -> b
(IxHas6 b _ _ _ _ _ _ _ _ _ _ _ _) -> b
_getIx1 :: Indexed a b t2 t3 t4 t5 t6 -> Maybe (HashMap b Int)
_getIx1 ux =
case ux of
(IxHas1 _ i _) -> Just i
(IxHas2 _ i _ _ _) -> Just i
(IxHas3 _ i _ _ _ _ _) -> Just i
(IxHas4 _ i _ _ _ _ _ _ _) -> Just i
(IxHas5 _ i _ _ _ _ _ _ _ _ _) -> Just i
(IxHas6 _ i _ _ _ _ _ _ _ _ _ _ _) -> Just i
_getIx2 :: Indexed a t1 b t3 t4 t5 t6 -> Maybe (HashMap b Int)
_getIx2 ux =
case ux of
(IxHas2 _ _ _ i _) -> Just i
(IxHas3 _ _ _ i _ _ _) -> Just i
(IxHas4 _ _ _ i _ _ _ _ _) -> Just i
(IxHas5 _ _ _ i _ _ _ _ _ _ _) -> Just i
(IxHas6 _ _ _ i _ _ _ _ _ _ _ _ _) -> Just i
_ -> Nothing
_getIx3 :: Indexed a t1 t2 b t4 t5 t6 -> Maybe (HashMap b Int)
_getIx3 ux =
case ux of
(IxHas3 _ _ _ _ _ i _) -> Just i
(IxHas4 _ _ _ _ _ i _ _ _) -> Just i
(IxHas5 _ _ _ _ _ i _ _ _ _ _) -> Just i
(IxHas6 _ _ _ _ _ i _ _ _ _ _ _ _) -> Just i
_ -> Nothing
_getIx4 :: Indexed a t1 t2 t3 b t5 t6 -> Maybe (HashMap b Int)
_getIx4 ux =
case ux of
(IxHas4 _ _ _ _ _ _ _ i _) -> Just i
(IxHas5 _ _ _ _ _ _ _ i _ _ _) -> Just i
(IxHas6 _ _ _ _ _ _ _ i _ _ _ _ _) -> Just i
_ -> Nothing
_getIx5 :: Indexed a t1 t2 t3 t4 b t6 -> Maybe (HashMap b Int)
_getIx5 ux =
case ux of
(IxHas5 _ _ _ _ _ _ _ _ _ i _) -> Just i
(IxHas6 _ _ _ _ _ _ _ _ _ i _ _ _) -> Just i
_ -> Nothing
_getIx6 :: Indexed a t1 t2 t3 t4 t5 b -> Maybe (HashMap b Int)
_getIx6 ux =
case ux of
(IxHas6 _ _ _ _ _ _ _ _ _ _ _ i _) -> Just i
_ -> Nothing
instance (Eq a, Eq t1, Eq t2, Eq t3, Eq t4, Eq t5, Eq t6, Hashable t1,
Hashable t2, Hashable t3, Hashable t4, Hashable t5, Hashable t6,
t1 ~ I1 a, t2 ~ I2 a, t3 ~ I3 a, t4 ~ I4 a, t5 ~ I5 a, t6 ~ I6 a,
SafeCopy a, SimpleIx a) => SafeCopy (Indexed a t1 t2 t3 t4 t5 t6) where
version = 0
putCopy ux = contain $ safePut $ _ixData ux
getCopy = contain $ fmap withData safeGet
where
withData ::
(Eq a, Eq t1, Eq t2, Eq t3, Eq t4, Eq t5, Eq t6, Hashable t1,
Hashable t2, Hashable t3, Hashable t4, Hashable t5, Hashable t6,
t1 ~ I1 a, t2 ~ I2 a, t3 ~ I3 a, t4 ~ I4 a, t5 ~ I5 a, t6 ~ I6 a,
SafeCopy a, SimpleIx a) => Seq a -> Indexed a t1 t2 t3 t4 t5 t6
withData seq = Fold.foldl ixInsert create seq