crjdt-haskell: A Conflict-Free Replicated JSON Datatype for Haskell

[ bsd3, data, library ] [ Propose Tags ]

A Conflict-Free Replicated JSON Datatype for Haskell


[Skip to Readme]

Downloads

Note: This package has metadata revisions in the cabal description newer than included in the tarball. To unpack the package including the revisions, use 'cabal get'.

Maintainer's Corner

Package maintainers

For package maintainers and hackage trustees

Candidates

Versions [RSS] 0.1.0.0, 0.2.0.0, 0.2.1, 0.3.0
Dependencies base (>=4.8 && <5), containers (>=0.5.0.0 && <0.6), free (>=4.6.1 && <5), mtl (>=2.2.1 && <2.3), text (>=0.11.1.0 && <1.3) [details]
License BSD-3-Clause
Copyright 2017 Amar Potghan
Author Amar Potghan
Maintainer amarpotghan@gmail.com
Revised Revision 1 made by HerbertValerioRiedel at 2017-05-28T21:23:50Z
Category Data
Home page https://github.com/amarpotghan/crjdt-haskell#readme
Source repo head: git clone https://github.com/amarpotghan/crjdt-haskell
Uploaded by amarpotghan at 2017-05-07T19:40:49Z
Distributions
Reverse Dependencies 1 direct, 0 indirect [details]
Downloads 3405 total (11 in the last 30 days)
Rating (no votes yet) [estimated by Bayesian average]
Your Rating
  • λ
  • λ
  • λ
Status Docs uploaded by user
Build status unknown [no reports yet]

Readme for crjdt-haskell-0.1.0.0

[back to package description]

Build Status

A Conflict-Free Replicated JSON Datatype for Haskell

crjdt-haskell provides high level interface to CRDT which is formalised in the paper by Martin Kleppmann and Alastair R. Beresford.

Example


{-# LANGUAGE OverloadedStrings #-}
module Main where

import Data.Crjdt as C

-- Original state
original :: Command ()
original = (doc .> key "key") =: "A"

-- First replica updates doc["key"] to "B"
replica1 :: Command ()
replica1 = do
  original
  (doc .> key "key") =: "B"

-- Second replica updates doc["key"] to "C"
replica2 :: Command ()
replica2 = do
  original
  (doc .> key "key") =: "C"

main :: IO ()
main = do
  -- Sync first and second replica
  (r1, r2) <- sync (1, replica1) (2, replica2)

  let replica1' = execEval 1 r1
      replica2' = execEval 2 r2

  -- Both replicas converge to: {"key": {"B", "C"}}
  print (document replica1' == document replica2') -- True

Future work

  • Aeson support
  • Simplify API as described in second version of the paper

LICENSE

Copyright © 2017 Amar Potghan

Distributed under BSD License.