haxl-0.1.0.0: A Haskell library for efficient, concurrent, and concise data access.

Safe HaskellNone

Haxl.Prelude

Contents

Description

Support for using Haxl as a DSL. This module provides most of the standard Prelude, plus a selection of stuff that makes it Haxl client code cleaner and more concise.

We intend Haxl client code to:

  • Import Haxl.Prelude
  • Use RebindableSyntax. This implies NoImplicitPrelude, and allows if-then-else to be used with a monadic condition.
  • Use OverloadedStrings (we use Text a lot)

Synopsis

The Standard Haskell Prelude

Everything from Prelude except mapM, mapM_, sequence, and sequence

module Prelude

Haxl and Fetching data

data GenHaxl u a Source

The Haxl monad, which does several things:

  • It is a reader monad for Env and IORef RequestStore, The latter is the current batch of unsubmitted data fetch requests.
  • It is a concurrency, or resumption, monad. A computation may run partially and return Blocked, in which case the framework should perform the outstanding requests in the RequestStore, and then resume the computation.
  • The Applicative combinator <*> explores both branches in the event that the left branch is Blocked, so that we can collect multiple requests and submit them as a batch.
  • It contains IO, so that we can perform real data fetching.

Instances

Monad (GenHaxl u) 
Functor (GenHaxl u) 
Applicative (GenHaxl u) 
Fractional a => Fractional (GenHaxl u a) 
Num a => Num (GenHaxl u a) 
IsString a => IsString (GenHaxl u a) 
~ * u1 u2 => IfThenElse (GenHaxl u1 Bool) (GenHaxl u2 a) 

dataFetch :: (DataSource u r, Request r a) => r a -> GenHaxl u aSource

Performs actual fetching of data for a Request from a DataSource.

class (DataSourceName req, StateKey req, Show1 req) => DataSource u req Source

The class of data sources, parameterised over the request type for that data source. Every data source must implement this class.

A data source keeps track of its state by creating an instance of StateKey to map the request type to its state. In this case, the type of the state should probably be a reference type of some kind, such as IORef.

For a complete example data source, see ExampleDataSource.

Extra Monad and Applicative things

class Functor f => Applicative f where

A functor with application, providing operations to

  • embed pure expressions (pure), and
  • sequence computations and combine their results (<*>).

A minimal complete definition must include implementations of these functions satisfying the following laws:

identity
pure id <*> v = v
composition
pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
homomorphism
pure f <*> pure x = pure (f x)
interchange
u <*> pure y = pure ($ y) <*> u

The other methods have the following default definitions, which may be overridden with equivalent specialized implementations:

      u *> v = pure (const id) <*> u <*> v
      u <* v = pure const <*> u <*> v

As a consequence of these laws, the Functor instance for f will satisfy

      fmap f x = pure f <*> x

If f is also a Monad, it should satisfy pure = return and (<*>) = ap (which implies that pure and <*> satisfy the applicative functor laws).

Methods

pure :: a -> f a

Lift a value.

(<*>) :: f (a -> b) -> f a -> f b

Sequential application.

(*>) :: f a -> f b -> f b

Sequence actions, discarding the value of the first argument.

(<*) :: f a -> f b -> f a

Sequence actions, discarding the value of the second argument.

mapM :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b)Source

We don't want the monadic mapM, because that doesn't do batching. There doesn't seem to be a way to make mapM have the right behaviour when used with Haxl, so instead we define mapM to be traverse in Haxl code.

mapM_ :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f ()Source

See mapM.

sequence :: (Traversable t, Applicative f) => t (f a) -> f (t a)Source

See mapM.

sequence_ :: (Traversable t, Applicative f) => t (f a) -> f ()Source

See mapM.

(<$>) :: Functor f => (a -> b) -> f a -> f b

An infix synonym for fmap.

filterM :: (Applicative f, Monad f) => (a -> f Bool) -> [a] -> f [a]Source

See mapM.

foldM :: Monad m => (a -> b -> m a) -> a -> [b] -> m a

The foldM function is analogous to foldl, except that its result is encapsulated in a monad. Note that foldM works from left-to-right over the list arguments. This could be an issue where (>>) and the `folded function' are not commutative.

       foldM f a1 [x1, x2, ..., xm]

==

       do
         a2 <- f a1 x1
         a3 <- f a2 x2
         ...
         f am xm

If right-to-left evaluation is required, the input list should be reversed.

forM :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b)Source

forM_ :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f ()Source

foldl' :: (a -> b -> a) -> a -> [b] -> a

A strict version of foldl.

sort :: Ord a => [a] -> [a]

The sort function implements a stable sorting algorithm. It is a special case of sortBy, which allows the programmer to supply their own comparison function.

class Monoid a where

The class of monoids (types with an associative binary operation that has an identity). Instances should satisfy the following laws:

  • mappend mempty x = x
  • mappend x mempty = x
  • mappend x (mappend y z) = mappend (mappend x y) z
  • mconcat = foldr mappend mempty

The method names refer to the monoid of lists under concatenation, but there are many other instances.

Minimal complete definition: mempty and mappend.

Some types can be viewed as a monoid in more than one way, e.g. both addition and multiplication on numbers. In such cases we often define newtypes and make those instances of Monoid, e.g. Sum and Product.

Methods

mempty :: a

Identity of mappend

mappend :: a -> a -> a

An associative operation

mconcat :: [a] -> a

Fold a list using the monoid. For most types, the default definition for mconcat will be used, but the function is included in the class definition so that an optimized version can be provided for specific types.

Instances

Monoid Ordering 
Monoid () 
Monoid Text 
Monoid All 
Monoid Any 
Monoid Doc 
Monoid Text 
Monoid [a] 
Monoid a => Monoid (Maybe a)

Lift a semigroup into Maybe forming a Monoid according to http://en.wikipedia.org/wiki/Monoid: "Any semigroup S may be turned into a monoid simply by adjoining an element e not in S and defining e*e = e and e*s = s = s*e for all s ∈ S." Since there is no "Semigroup" typeclass providing just mappend, we use Monoid instead.

Monoid (Result a) 
Monoid (Parser a) 
Monoid a => Monoid (Dual a) 
Monoid (Endo a) 
Num a => Monoid (Sum a) 
Num a => Monoid (Product a) 
Monoid (First a) 
Monoid (Last a) 
Unbox a => Monoid (Vector a) 
Monoid b => Monoid (a -> b) 
(Monoid a, Monoid b) => Monoid (a, b) 
(Eq k, Hashable k) => Monoid (HashMap k v) 
Ord k => Monoid (Map k v) 
(Monoid a, Monoid b, Monoid c) => Monoid (a, b, c) 
(Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a, b, c, d) 
(Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => Monoid (a, b, c, d, e) 

join :: Monad m => m (m a) -> m a

The join function is the conventional monad join operator. It is used to remove one level of monadic structure, projecting its bound argument into the outer level.

Lifted operations

class IfThenElse a b whereSource

Methods

ifThenElse :: a -> b -> b -> bSource

Instances

IfThenElse Bool a 
~ * u1 u2 => IfThenElse (GenHaxl u1 Bool) (GenHaxl u2 a) 

(.>) :: Ord a => GenHaxl u a -> GenHaxl u a -> GenHaxl u BoolSource

(.<) :: Ord a => GenHaxl u a -> GenHaxl u a -> GenHaxl u BoolSource

(.>=) :: Ord a => GenHaxl u a -> GenHaxl u a -> GenHaxl u BoolSource

(.<=) :: Ord a => GenHaxl u a -> GenHaxl u a -> GenHaxl u BoolSource

(.==) :: Eq a => GenHaxl u a -> GenHaxl u a -> GenHaxl u BoolSource

(./=) :: Eq a => GenHaxl u a -> GenHaxl u a -> GenHaxl u BoolSource

(.++) :: GenHaxl u [a] -> GenHaxl u [a] -> GenHaxl u [a]Source

pair :: GenHaxl u a -> GenHaxl u b -> GenHaxl u (a, b)Source

Text things

data Text

A space efficient, packed, unboxed Unicode text type.

Instances

Eq Text 
Data Text

This instance preserves data abstraction at the cost of inefficiency. We omit reflection services for the sake of data abstraction.

This instance was created by copying the updated behavior of Data.Set.Set and Data.Map.Map. If you feel a mistake has been made, please feel free to submit improvements.

The original discussion is archived here: could we get a Data instance for Data.Text.Text?

The followup discussion that changed the behavior of Set and Map is archived here: Proposal: Allow gunfold for Data.Map, ...

Ord Text 
Read Text 
Show Text 
Typeable Text 
IsString Text 
ToJSON Text 
FromJSON Text 
Monoid Text 
NFData Text 
Hashable Text 
ToJSON v => ToJSON (HashMap Text v) 
ToJSON v => ToJSON (Map Text v) 
FromJSON v => FromJSON (HashMap Text v) 
FromJSON v => FromJSON (Map Text v) 

class IsString a where

Class for string-like datastructures; used by the overloaded string extension (-foverloaded-strings in GHC).

Methods

fromString :: String -> a

Exceptions

throw :: Exception e => e -> GenHaxl u aSource

Throw an exception in the Haxl monad

catch :: Exception e => GenHaxl u a -> (e -> GenHaxl u a) -> GenHaxl u aSource

try :: Exception e => GenHaxl u a -> GenHaxl u (Either e a)Source

withDefault :: a -> GenHaxl u a -> GenHaxl u aSource

Runs the given GenHaxl computation, and if it throws a TransientError or LogicError exception (see Haxl.Core.Exception), the exception is ignored and the supplied default value is returned instead.

catchAnySource

Arguments

:: GenHaxl u a

run this first

-> GenHaxl u a

if it throws LogicError or TransientError, run this

-> GenHaxl u a 

Catch LogicErrors and TransientErrors and perform an alternative action

data HaxlException Source

We have a 3-tiered hierarchy of exceptions, with HaxlException at the top, and all Haxl exceptions as children of this. Users should never deal directly with HaxlExceptions.

The main types of exceptions are:

InternalError
Something is wrong with Haxl core.
LogicError
Something is wrong with Haxl client code.
TransientError
Something is temporarily failing (usually in a fetch).

These are not meant to be thrown (but likely be caught). Thrown exceptions should be a subclass of one of these. There are some generic leaf exceptions defined below this, such as FetchError (generic transient failure) or CriticalError (internal failure).

Constructors

forall e . (Exception e, MiddleException e) => HaxlException e 

Instances

Show HaxlException 
Typeable HaxlException 
ToJSON HaxlException

These need to be serializable to JSON to cross FFI boundaries.

Exception HaxlException 

data TransientError Source

For transient failures.

Constructors

forall e . Exception e => TransientError e 

data LogicError Source

For errors in Haxl client code.

Constructors

forall e . Exception e => LogicError e 

data NotFound Source

Generic "something was not found" exception.

Constructors

NotFound Text 

data UnexpectedType Source

Generic "something had the wrong type" exception.

Constructors

UnexpectedType Text 

data FetchError Source

Generic transient fetching exceptions.

Constructors

FetchError Text 

data EmptyList Source

Generic "input list was empty" exception.

Constructors

EmptyList Text 

data InvalidParameter Source

Generic "passing some invalid parameter" exception.

Constructors

InvalidParameter Text