Copyright | (C) 2016 Rev. Johnny Healey |
---|---|
License | LGPL-3 |
Maintainer | Rev. Johnny Healey <rev.null@gmail.com> |
Stability | experimental |
Portability | unknown |
Safe Haskell | None |
Language | Haskell2010 |
A FixFile
is file for storing recursive data. The file supports MVCC
through an append-only file.
In order to eliminate distinctions between data structures that are file-backed versus in-memory, this library makes heavy use of lazy IO. Transactions are used to ensure safety of the unsafe IO.
The data structures used by a FixFile
should not be recursive directly,
but should have instances of Typeable
, Traversable
, and Binary
and
should be structured such that the fixed point of the data type is
recursive.
There is also the concept of the Root
data of a FixFile
. This can be
used as a kind of header for a FixFile that can allow several recursive
data structures to be modified in a single transaction.
- class Fixed g where
- newtype Fix f = InF {}
- data Stored s f
- class Null f where
- class Null1 f where
- type CataAlg f a = f a -> a
- type CataMAlg m f a = f a -> m a
- cata :: (Functor f, Fixed g) => CataAlg f a -> g f -> a
- cataM :: (Traversable f, Fixed g, Monad m) => CataMAlg m f a -> g f -> m a
- type AnaAlg f a = a -> f a
- type AnaMAlg m f a = a -> m (f a)
- ana :: (Functor f, Fixed g) => AnaAlg f a -> a -> g f
- anaM :: (Traversable f, Fixed g, Monad m) => AnaMAlg m f a -> a -> m (g f)
- type ParaAlg g f a = f (g f, a) -> a
- type ParaMAlg m g f a = f (g f, a) -> m a
- para :: (Functor f, Fixed g) => ParaAlg g f a -> g f -> a
- paraM :: (Traversable f, Fixed g, Monad m) => ParaMAlg m g f a -> g f -> m a
- hylo :: Functor f => AnaAlg f a -> CataAlg f b -> a -> b
- hyloM :: (Traversable f, Monad m) => AnaMAlg m f a -> CataMAlg m f b -> a -> m b
- iso :: (Functor f, Fixed g, Fixed h) => g f -> h f
- class FixedAlg f where
- class FixedAlg f => FixedSub f where
- class FixedSub f => FixedFunctor f where
- fmapF' :: (FixedFunctor f, Fixed g, a ~ Alg f) => (a -> b) -> g f -> g (Sub f a b)
- class FixedAlg f => FixedFoldable f where
- class FixedSub f => FixedTraversable f where
- traverseF' :: (FixedTraversable f, Fixed g, Applicative h, a ~ Alg f) => (a -> h b) -> g f -> h (g (Sub f a b))
- type Fixable f = (Traversable f, Binary (f (Ptr f)), Typeable f, Null1 f)
- class FixTraverse t where
- type Root r = (FixTraverse r, Binary (r Ptr))
- data Ptr f
- newtype Ref f g = Ref {
- deRef :: g f
- ref :: Lens' (Ref f g) (g f)
- data FixFile r
- createFixFile :: Root r => r Fix -> FilePath -> IO (FixFile r)
- createFixFileHandle :: Root r => r Fix -> FilePath -> Handle -> IO (FixFile r)
- openFixFile :: Binary (r Ptr) => FilePath -> IO (FixFile r)
- openFixFileHandle :: Binary (r Ptr) => FilePath -> Handle -> IO (FixFile r)
- closeFixFile :: FixFile r -> IO ()
- fixFilePath :: FixFile r -> FilePath
- clone :: Root r => FilePath -> FixFile r -> IO ()
- cloneH :: Root r => FixFile r -> Handle -> IO ()
- vacuum :: Root r => FixFile r -> IO ()
- data Transaction r s a
- alterT :: (tr ~ Transaction (Ref f) s, Traversable f, Binary (f (Ptr f))) => (Stored s f -> Stored s f) -> tr ()
- lookupT :: (tr ~ Transaction (Ref f) s, Traversable f, Binary (f (Ptr f))) => (Stored s f -> a) -> tr a
- readTransaction :: Root r => FixFile r -> (forall s. Transaction r s a) -> IO a
- writeTransaction :: Root r => FixFile r -> (forall s. Transaction r s a) -> IO a
- writeExceptTransaction :: Root r => FixFile r -> (forall s. ExceptT e (Transaction r s) a) -> IO (Either e a)
- subTransaction :: Lens' (r (Stored s)) (r' (Stored s)) -> Transaction r' s a -> Transaction r s a
- getRoot :: Root r => Transaction r s (r Fix)
- getFull :: Functor f => Transaction (Ref f) s (Fix f)
Fixed point combinators
Stored
is a fixed-point combinator of f
in Transaction s
.
Fixed (Stored s) Source # | |
MonadState (r (Stored s)) (Transaction r s) Source # | |
Null typeclasses
Null1
is for expressing null types of kind (* -> *)
.
F-Algebras
cataM :: (Traversable f, Fixed g, Monad m) => CataMAlg m f a -> g f -> m a Source #
cataM
is a monadic catamorphism.
ana :: (Functor f, Fixed g) => AnaAlg f a -> a -> g f Source #
ana
applies an AnaAlg over an argument to produce a fixed-point
of a Functor.
anaM :: (Traversable f, Fixed g, Monad m) => AnaMAlg m f a -> a -> m (g f) Source #
anaM
is a monadic anamorphism.
paraM :: (Traversable f, Fixed g, Monad m) => ParaMAlg m g f a -> g f -> m a Source #
paraM
is a monadic paramorphism.
hylo :: Functor f => AnaAlg f a -> CataAlg f b -> a -> b Source #
hylo
combines ana and cata into a single operation.
hyloM :: (Traversable f, Monad m) => AnaMAlg m f a -> CataMAlg m f b -> a -> m b Source #
hyloM
is a monadic hylomorphism.
Fixed Typeclasses
class FixedSub f => FixedFunctor f where Source #
FixedFunctor
is a typeclass for describing mapping behavior for datatypes
used with Fixed
combinators.
FixedFunctor (Tree23 (Map k v)) Source # | |
FixedFunctor (Trie v) Source # | |
FixedFunctor (Trie v) Source # | |
FixedFunctor (BTree n k v) Source # | |
FixedFunctor (BTree n k v) Source # | |
class FixedAlg f => FixedFoldable f where Source #
FixedFoldable
is a typeclass for describing folds over datatypes with
Fixed
combinators.
FixedFoldable (Set i) Source # | |
FixedFoldable (Tree23 (Map k v)) Source # | |
FixedFoldable (Tree23 (Set k)) Source # | |
FixedFoldable (Trie v) Source # | |
FixedFoldable (Trie v) Source # | |
FixedFoldable (BTree n k v) Source # | |
FixedFoldable (BTree n k v) Source # | |
class FixedSub f => FixedTraversable f where Source #
FixedTraversable
is a typeclass for describing traversals over datatypes
with Fixed
combinators.
traverseF :: (Fixed g, Fixed g', Applicative h, a ~ Alg f) => (a -> h b) -> g f -> h (g' (Sub f a b)) Source #
Traverse over a Fixed
recursive FixedSub
f
in the Applicative
h
.
FixedTraversable (Tree23 (Map k v)) Source # | |
FixedTraversable (Trie v) Source # | |
FixedTraversable (Trie v) Source # | |
FixedTraversable (BTree n k v) Source # | |
FixedTraversable (BTree n k v) Source # | |
traverseF' :: (FixedTraversable f, Fixed g, Applicative h, a ~ Alg f) => (a -> h b) -> g f -> h (g (Sub f a b)) Source #
Root Data
type Fixable f = (Traversable f, Binary (f (Ptr f)), Typeable f, Null1 f) Source #
A Constraint for data that can be used with a Ref
class FixTraverse t where Source #
FixTraverse
is a class based on Traverse
but taking an argument of kind
((* -> *) -> *)
instead of *
.
traverseFix :: Applicative f => (forall g. Fixable g => a g -> f (b g)) -> t a -> f (t b) Source #
Given a function that maps from a
to b
over
in the
Fixable
gApplicative
f
, traverse over t
changing the fixed-point
combinator from a
to b
.
Fixable f => FixTraverse (Ref f) Source # | |
type Root r = (FixTraverse r, Binary (r Ptr)) Source #
A Root
is a datastructure that is an instance of FixTraverse
and
Binary
. This acts as a sort of "header" for the file where the Root
may have several Ref
s under it to different Functors
.
A Ptr
points to a location in a FixFile
and has a phantom type for a
Functor
f
. A Root
expects an argument that resembles a Fixed
,
but we can pass it a Ptr
instead. This is not a well-formed Fixed
because it can't be unpacked into
.f
(Ptr
f
)
But, it can be serialized, which allows a Root
object that takes this
as an argument to be serialized.
FixFiles
closeFixFile :: FixFile r -> IO () Source #
Close a FixFile
. This can potentially cause errors on data that is lazily
being read from a Transaction
.
vacuum :: Root r => FixFile r -> IO () Source #
Because a FixFile
is backed by an append-only file, there is a periodic
need to vacuum
the file to garbage collect data that is no longer
referenced from the root. This task operates on a temporary file that then
replaces the file that backs FixFile.
The memory usage of this operation scales with the recursive depth of the structure stored in the file.
Transactions
data Transaction r s a Source #
A Transaction
is an isolated execution of a read or update operation
on the root object stored in a FixFile
. r
is the Root
data that is
stored by the FixFile
. s
is a phantom type used to isolate Stored
values to the transaction where they are run.
MonadState (r (Stored s)) (Transaction r s) Source # | |
Monad (Transaction f s) Source # | |
Functor (Transaction f s) Source # | |
Applicative (Transaction f s) Source # | |
alterT :: (tr ~ Transaction (Ref f) s, Traversable f, Binary (f (Ptr f))) => (Stored s f -> Stored s f) -> tr () Source #
lookupT :: (tr ~ Transaction (Ref f) s, Traversable f, Binary (f (Ptr f))) => (Stored s f -> a) -> tr a Source #
readTransaction :: Root r => FixFile r -> (forall s. Transaction r s a) -> IO a Source #
Perform a read transaction on a FixFile
. This transaction cannot
modify the root object stored in the file. The returned value is lazily
evaluated, but will always correspond to the root object at the start
of the transaction.
writeTransaction :: Root r => FixFile r -> (forall s. Transaction r s a) -> IO a Source #
Perform a write transaction on a FixFile
. This operation differs from
the readTransaction in that the root object stored in the file can
potentially be updated by this Transaction
.
writeExceptTransaction :: Root r => FixFile r -> (forall s. ExceptT e (Transaction r s) a) -> IO (Either e a) Source #
The writeExceptTransaction
function behaves like writeTransaction
, but
applies to a Transaction
wrapped in ExceptT
. In the event that an
exception propagates through the Transaction
, the updates are not
committed to disk.
This is meant to provide a mechanism for aborting Transaction
s.
subTransaction :: Lens' (r (Stored s)) (r' (Stored s)) -> Transaction r' s a -> Transaction r s a Source #
Perform a Transaction
on a part of the root object.