module Data.Columbia.Dictionaries (
lazyMapToMap, mapToLazyMap,
lazyMapToAscList, lazyMapSize, lazyMapRange, lazyMapOpenRange, lazyMapMinKey, lazyMapMaxKey, lazyMapMerge,
seekInRange) where
import Data.Word
import Data.Typeable hiding (Proxy)
import qualified Data.Map as M
import Data.Map (Map)
import Data.List
import Control.Monad.Reader
import Data.Generics.SYB.WithClass.Basics
import Data.Columbia.Internal.SeekableStream
import Data.Columbia.Internal.IntegralTypes
import Data.Columbia.Internal.Headers
import Data.Columbia.Internal.Orphans
import Data.Columbia.CompoundData
import Data.Columbia.WithAddress
import Data.Columbia.FRecord
import Unsafe.Coerce
data StrictMap k v = BinPrimePrime !Int !k v !(StrictMap k v) !(StrictMap k v) | TipPrimePrime
unsafeStrictMapToMap :: StrictMap k v -> Map k v
unsafeStrictMapToMap = unsafeCoerce
lazyMapToStrictMap :: LazyMap k v -> StrictMap k v
lazyMapToStrictMap (BinPrime sz k v bin bin2) = BinPrimePrime sz k v(lazyMapToStrictMap(copoint bin)) (lazyMapToStrictMap(copoint bin2))
lazyMapToStrictMap TipPrime = TipPrimePrime
lazyMapToMap :: LazyMap k v -> Map k v
lazyMapToMap = unsafeStrictMapToMap. lazyMapToStrictMap
unsafeMapToStrictMap :: Map k v -> StrictMap k v
unsafeMapToStrictMap = unsafeCoerce
strictMapToLazyMap :: StrictMap k v -> LazyMap k v
strictMapToLazyMap (BinPrimePrime sz k v bin bin2) = BinPrime sz k v(point(strictMapToLazyMap bin)) (point(strictMapToLazyMap bin2))
strictMapToLazyMap TipPrimePrime = TipPrime
mapToLazyMap :: Map k v -> LazyMap k v
mapToLazyMap = strictMapToLazyMap. unsafeMapToStrictMap
lazyMapToAscList :: LazyMap k v -> [(k,v)]
lazyMapToAscList (BinPrime _ k v bin bin2) = lazyMapToAscList(copoint bin) ++ (k,v) : lazyMapToAscList(copoint bin2)
lazyMapToAscList TipPrime = []
lazyMapSize :: LazyMap k v -> Int
lazyMapSize (BinPrime sz _ _ _ _) = sz
lazyMapSize TipPrime = 0
lazyMapRange :: (Ord k) => k -> k -> WithAddress(LazyMap k v) -> WithAddress(LazyMap k v)
lazyMapRange k k2 bin = case copoint bin of
BinPrime _ k3 v bin' bin2' -> let
bin'' = lazyMapRange k k2 bin'
bin2'' = lazyMapRange k k2 bin2' in
if k3 < k then
bin2''
else if k3 > k2 then
bin''
else
point$BinPrime(succ(lazyMapSize(copoint bin'')+lazyMapSize(copoint bin2''))) k3 v bin'' bin2''
TipPrime -> bin
lazyMapOpenRange :: (Ord k) => k -> k -> WithAddress(LazyMap k v) -> WithAddress(LazyMap k v)
lazyMapOpenRange k k2 bin = case copoint bin of
BinPrime _ k3 v bin' bin2' -> let
bin'' = lazyMapOpenRange k k2 bin'
bin2'' = lazyMapOpenRange k k2 bin2' in
if k3 <= k then
bin2''
else if k3 >= k2 then
bin''
else
point$BinPrime(succ(lazyMapSize(copoint bin'')+lazyMapSize(copoint bin2''))) k3 v bin'' bin2''
TipPrime -> bin
lazyMapMinKey :: LazyMap k v -> Maybe k
lazyMapMinKey (BinPrime _ k _ bin _) = lazyMapMinKey(copoint bin) `mplus` return k
lazyMapMinKey TipPrime = mzero
lazyMapMaxKey :: LazyMap k v -> Maybe k
lazyMapMaxKey (BinPrime _ k _ _ bin2) = lazyMapMaxKey(copoint bin2) `mplus` return k
lazyMapMaxKey TipPrime = mzero
lazyMapMerge :: WithAddress(LazyMap k v) -> WithAddress(LazyMap k v) -> WithAddress(LazyMap k v)
lazyMapMerge bin bin2 = case copoint bin of
BinPrime sz k v bin' bin2' -> point$BinPrime(sz+lazyMapSize(copoint bin2)) k v bin'(lazyMapMerge bin2' bin2)
TipPrime -> bin2
_findSplitAddresses :: (Ord k, Data ctx k, Sat(ctx Int), HasField ctx RWCtx, Monad m)
=> Proxy ctx
-> k
-> k
-> ReaderT(SeekableStream m Word8) m [(k,Either Word32 Word32)]
_findSplitAddresses proxy k k2 = do
n <- getPosition
seekByPointer
hdr@(_, ctor, _) <- readHeader
seek n
if ctor == 1 then do
seekToField 1
sz :: Int <- fixT proxy readOneLayer
seek n
seekToField 2
k3 <- fixT proxy readOneLayer
if k3 < k then do
seek n
seekToField 5
_findSplitAddresses proxy k k2
else if k3 > k2 then do
seek n
seekToField 4
_findSplitAddresses proxy k k2
else if sz == 1 then
return$![(k3,Right n)]
else do
seek n
seekToField 4
n1 <- getPosition
ls <- _findSplitAddresses proxy k k2
seek n
seekToField 5
n2 <- getPosition
ls2 <- _findSplitAddresses proxy k k2
let ls' = snd <$> ls
let ls2' = snd <$> ls2
return$!if ls' == [Right n1] && ls2' == [Right n2] then
[(k3,Right n)]
else
ls ++ (k3,Left n) : ls2
else
return$![]
seekInRange :: forall ctx k v m. (Ord k,
Data ctx k,
Data ctx v,
Sat(ctx Int),
Sat(ctx(LazyMap k v)),
Sat(ctx Word32),
Sat(ctx(WithAddress(LazyMap k v))),
HasField ctx RWCtx,
Monad m)
=> k
-> k
-> PolyTraversal ctx m(WithAddress(LazyMap k v))
seekInRange k k2 proxy m = do
ls <- _findSplitAddresses proxy k k2
liftM(foldl' lazyMapMerge(point TipPrime))$
mapM(\(k,ei)->either
(\n->do { seek n; seekToField 3; liftM(point.mapToLazyMap. M.singleton k) m })
(\n->do { seek n; m })
ei)
ls