{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric  #-}

-- | VolatileDB Index
--
-- Intended for qualified import
-- > import qualified Ouroboros.Consensus.Storage.VolatileDB.Impl.Index as Index
module Ouroboros.Consensus.Storage.VolatileDB.Impl.Index (
    delete
  , elems
  , empty
  , insert
  , lastFile
  , lookup
  , toAscList
    -- * opaque
  , Index
  ) where

import           Prelude hiding (lookup)

import           Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks (..))

import           Ouroboros.Consensus.Storage.VolatileDB.Impl.FileInfo (FileInfo)
import           Ouroboros.Consensus.Storage.VolatileDB.Impl.Types (FileId)

-- | Mapping from 'FileId' to 'FileInfo'
newtype Index blk = Index { Index blk -> IntMap (FileInfo blk)
unIndex :: IntMap (FileInfo blk) }
  deriving ((forall x. Index blk -> Rep (Index blk) x)
-> (forall x. Rep (Index blk) x -> Index blk)
-> Generic (Index blk)
forall x. Rep (Index blk) x -> Index blk
forall x. Index blk -> Rep (Index blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (Index blk) x -> Index blk
forall blk x. Index blk -> Rep (Index blk) x
$cto :: forall blk x. Rep (Index blk) x -> Index blk
$cfrom :: forall blk x. Index blk -> Rep (Index blk) x
Generic, Context -> Index blk -> IO (Maybe ThunkInfo)
Proxy (Index blk) -> String
(Context -> Index blk -> IO (Maybe ThunkInfo))
-> (Context -> Index blk -> IO (Maybe ThunkInfo))
-> (Proxy (Index blk) -> String)
-> NoThunks (Index blk)
forall blk.
StandardHash blk =>
Context -> Index blk -> IO (Maybe ThunkInfo)
forall blk. StandardHash blk => Proxy (Index blk) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (Index blk) -> String
$cshowTypeOf :: forall blk. StandardHash blk => Proxy (Index blk) -> String
wNoThunks :: Context -> Index blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall blk.
StandardHash blk =>
Context -> Index blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> Index blk -> IO (Maybe ThunkInfo)
$cnoThunks :: forall blk.
StandardHash blk =>
Context -> Index blk -> IO (Maybe ThunkInfo)
NoThunks)

modifyIndex ::
     (IntMap (FileInfo blk) -> IntMap (FileInfo blk))
  -> Index blk
  -> Index blk
modifyIndex :: (IntMap (FileInfo blk) -> IntMap (FileInfo blk))
-> Index blk -> Index blk
modifyIndex IntMap (FileInfo blk) -> IntMap (FileInfo blk)
f (Index IntMap (FileInfo blk)
index) = IntMap (FileInfo blk) -> Index blk
forall blk. IntMap (FileInfo blk) -> Index blk
Index (IntMap (FileInfo blk) -> IntMap (FileInfo blk)
f IntMap (FileInfo blk)
index)

empty :: Index blk
empty :: Index blk
empty = IntMap (FileInfo blk) -> Index blk
forall blk. IntMap (FileInfo blk) -> Index blk
Index IntMap (FileInfo blk)
forall a. IntMap a
IM.empty

lookup :: FileId -> Index blk -> Maybe (FileInfo blk)
lookup :: FileId -> Index blk -> Maybe (FileInfo blk)
lookup FileId
fileId (Index IntMap (FileInfo blk)
index) = FileId -> IntMap (FileInfo blk) -> Maybe (FileInfo blk)
forall a. FileId -> IntMap a -> Maybe a
IM.lookup FileId
fileId IntMap (FileInfo blk)
index

insert :: FileId -> FileInfo blk -> Index blk -> Index blk
insert :: FileId -> FileInfo blk -> Index blk -> Index blk
insert FileId
fileId FileInfo blk
fileInfo = (IntMap (FileInfo blk) -> IntMap (FileInfo blk))
-> Index blk -> Index blk
forall blk.
(IntMap (FileInfo blk) -> IntMap (FileInfo blk))
-> Index blk -> Index blk
modifyIndex (FileId
-> FileInfo blk -> IntMap (FileInfo blk) -> IntMap (FileInfo blk)
forall a. FileId -> a -> IntMap a -> IntMap a
IM.insert FileId
fileId FileInfo blk
fileInfo)

delete :: FileId -> Index blk -> Index blk
delete :: FileId -> Index blk -> Index blk
delete FileId
fileId = (IntMap (FileInfo blk) -> IntMap (FileInfo blk))
-> Index blk -> Index blk
forall blk.
(IntMap (FileInfo blk) -> IntMap (FileInfo blk))
-> Index blk -> Index blk
modifyIndex (FileId -> IntMap (FileInfo blk) -> IntMap (FileInfo blk)
forall a. FileId -> IntMap a -> IntMap a
IM.delete FileId
fileId)

toAscList :: Index blk -> [(FileId, FileInfo blk)]
toAscList :: Index blk -> [(FileId, FileInfo blk)]
toAscList (Index IntMap (FileInfo blk)
index) = IntMap (FileInfo blk) -> [(FileId, FileInfo blk)]
forall a. IntMap a -> [(FileId, a)]
IM.toAscList IntMap (FileInfo blk)
index

elems :: Index blk -> [FileInfo blk]
elems :: Index blk -> [FileInfo blk]
elems (Index IntMap (FileInfo blk)
index) = IntMap (FileInfo blk) -> [FileInfo blk]
forall a. IntMap a -> [a]
IM.elems IntMap (FileInfo blk)
index

-- | Return the last, i.e. the /highest/, 'FileId' and corresponding
-- 'FileInfo' stored in the 'Index'. Return 'Nothing' when empty.
lastFile :: Index blk -> Maybe (FileId, FileInfo blk)
lastFile :: Index blk -> Maybe (FileId, FileInfo blk)
lastFile = (((FileId, FileInfo blk), IntMap (FileInfo blk))
 -> (FileId, FileInfo blk))
-> Maybe ((FileId, FileInfo blk), IntMap (FileInfo blk))
-> Maybe (FileId, FileInfo blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FileId, FileInfo blk), IntMap (FileInfo blk))
-> (FileId, FileInfo blk)
forall a b. (a, b) -> a
fst (Maybe ((FileId, FileInfo blk), IntMap (FileInfo blk))
 -> Maybe (FileId, FileInfo blk))
-> (Index blk
    -> Maybe ((FileId, FileInfo blk), IntMap (FileInfo blk)))
-> Index blk
-> Maybe (FileId, FileInfo blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap (FileInfo blk)
-> Maybe ((FileId, FileInfo blk), IntMap (FileInfo blk))
forall a. IntMap a -> Maybe ((FileId, a), IntMap a)
IM.maxViewWithKey (IntMap (FileInfo blk)
 -> Maybe ((FileId, FileInfo blk), IntMap (FileInfo blk)))
-> (Index blk -> IntMap (FileInfo blk))
-> Index blk
-> Maybe ((FileId, FileInfo blk), IntMap (FileInfo blk))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index blk -> IntMap (FileInfo blk)
forall blk. Index blk -> IntMap (FileInfo blk)
unIndex