imm-1.2.1.0: Execute arbitrary actions for each unread element of RSS/Atom feeds

Safe HaskellNone
LanguageHaskell98

Imm.Database

Contents

Description

DSL/interpreter model for a generic key-value database

Synopsis

DSL/interpreter

class (Ord (Key t), Show (Key t), Show (Entry t), Typeable t, Show t, Pretty t, Pretty (Key t), Pretty (Entry t)) => Table t Source #

Generic database table

Associated Types

type Key t :: * Source #

type Entry t :: * Source #

Instances

Table FeedTable Source # 

Associated Types

type Key FeedTable :: * Source #

type Entry FeedTable :: * Source #

data DatabaseF t next Source #

Database DSL

Constructors

Describe t (Doc -> next) 
FetchList t [Key t] (Either SomeException (Map (Key t) (Entry t)) -> next) 
FetchAll t (Either SomeException (Map (Key t) (Entry t)) -> next) 
Update t (Key t) (Entry t -> Entry t) (Either SomeException () -> next) 
InsertList t [(Key t, Entry t)] (Either SomeException () -> next) 
DeleteList t [Key t] (Either SomeException () -> next) 
Purge t (Either SomeException () -> next) 
Commit t (Either SomeException () -> next) 

Instances

Functor (DatabaseF t) Source # 

Methods

fmap :: (a -> b) -> DatabaseF t a -> DatabaseF t b #

(<$) :: a -> DatabaseF t b -> DatabaseF t a #

Monad m => PairingM (CoDatabaseF t m) (DatabaseF t) m Source # 

Methods

pairM :: (a -> b -> m r) -> CoDatabaseF t m a -> DatabaseF t b -> m r Source #

data CoDatabaseF t m a Source #

Database interpreter

Constructors

CoDatabaseF 

Fields

Instances

Functor m => Functor (CoDatabaseF t m) Source # 

Methods

fmap :: (a -> b) -> CoDatabaseF t m a -> CoDatabaseF t m b #

(<$) :: a -> CoDatabaseF t m b -> CoDatabaseF t m a #

Monad m => PairingM (CoDatabaseF t m) (DatabaseF t) m Source # 

Methods

pairM :: (a -> b -> m r) -> CoDatabaseF t m a -> DatabaseF t b -> m r Source #

Exception

Primitives

fetch :: (MonadFree f m, DatabaseF t :<: f, Table t, MonadThrow m) => t -> Key t -> m (Entry t) Source #

fetchList :: (MonadFree f m, DatabaseF t :<: f, MonadThrow m) => t -> [Key t] -> m (Map (Key t) (Entry t)) Source #

fetchAll :: (MonadThrow m, MonadFree f m, DatabaseF t :<: f) => t -> m (Map (Key t) (Entry t)) Source #

update :: (MonadFree f m, DatabaseF t :<: f, MonadThrow m) => t -> Key t -> (Entry t -> Entry t) -> m () Source #

insert :: (MonadThrow m, MonadFree f m, LoggerF :<: f, DatabaseF t :<: f) => t -> Key t -> Entry t -> m () Source #

insertList :: (MonadThrow m, MonadFree f m, LoggerF :<: f, DatabaseF t :<: f) => t -> [(Key t, Entry t)] -> m () Source #

delete :: (MonadThrow m, MonadFree f m, LoggerF :<: f, DatabaseF t :<: f) => t -> Key t -> m () Source #

deleteList :: (MonadThrow m, MonadFree f m, LoggerF :<: f, DatabaseF t :<: f) => t -> [Key t] -> m () Source #

purge :: (MonadThrow m, MonadFree f m, DatabaseF t :<: f, LoggerF :<: f) => t -> m () Source #

commit :: (MonadThrow m, MonadFree f m, DatabaseF t :<: f, LoggerF :<: f) => t -> m () Source #