diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Amar Potghan (c) 2017
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,54 @@
+[![Build Status](https://travis-ci.org/amarpotghan/crjdt-haskell.svg?branch=master)](https://travis-ci.org/amarpotghan/haskell-crjdt)
+
+# A Conflict-Free Replicated JSON Datatype for Haskell
+
+*crjdt-haskell* provides high level interface to CRDT which is formalised in the [paper](https://arxiv.org/pdf/1608.03960v1.pdf) by Martin Kleppmann and Alastair R. Beresford.
+
+## Example
+
+```haskell
+
+{-# 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](https://arxiv.org/abs/1608.03960) of the paper
+
+## LICENSE
+
+Copyright © 2017 Amar Potghan
+
+Distributed under BSD License.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/crjdt-haskell.cabal b/crjdt-haskell.cabal
new file mode 100644
--- /dev/null
+++ b/crjdt-haskell.cabal
@@ -0,0 +1,49 @@
+name:          crjdt-haskell
+version:       0.1.0.0
+synopsis:      A Conflict-Free Replicated JSON Datatype for Haskell
+description:   A Conflict-Free Replicated JSON Datatype for Haskell
+homepage:      https://github.com/amarpotghan/crjdt-haskell#readme
+license:       BSD3
+license-file:  LICENSE
+author:        Amar Potghan
+maintainer:    amarpotghan@gmail.com
+copyright:     2017 Amar Potghan
+category:      Data
+build-type:    Simple
+cabal-version: >=1.10
+
+extra-source-files:  README.md
+
+library
+  hs-source-dirs:      src
+  exposed-modules:     Data.Crjdt
+                     , Data.Crjdt.Context
+                     , Data.Crjdt.Types
+                     , Data.Crjdt.Eval
+                     , Data.Crjdt.Internal
+                     , Data.Crjdt.Internal.Core
+  build-depends:       base >= 4.7 && < 5
+                     , text >= 0.11.1.0 && < 1.3
+                     , containers >= 0.5.0.0  && < 0.6
+                     , mtl >= 2.2.1 && < 2.3
+                     , free >= 4.6.1 && < 5
+  default-language:    Haskell2010
+
+test-suite crjdt-haskell-test
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             Spec.hs
+  build-depends:       base
+                     , crjdt-haskell
+                     , hspec
+                     , containers >= 0.5.0.0  && < 0.6
+                     , mtl
+                     , hedgehog >= 0.1
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  other-modules: Data.CrjdtSpec
+               , Data.FigureSpec
+  default-language:    Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/amarpotghan/crjdt-haskell
diff --git a/src/Data/Crjdt.hs b/src/Data/Crjdt.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Crjdt.hs
@@ -0,0 +1,160 @@
+{-# LANGUAGE FlexibleContexts #-}
+-- |This module exports all necessarry data types and functions for
+-- expressing and executing commands which allow modifying and
+-- querying the state of JSON in local replica
+
+module Data.Crjdt
+  (
+  -- * Expressions
+    iter
+  , next
+  , key
+  , doc
+  , var
+
+  -- * Commands
+  , Command(..)
+  , yield
+  , keys
+  , values
+  , insert
+  , delete
+  , bind
+  , (-<)
+  , assign
+  , (=:)
+
+  -- * Values
+  , string
+  , emptyMap
+  , emptyList
+
+  -- * Evaluation and Execution
+  , Eval.eval
+  , Eval.execute
+
+  -- * Re-exports
+  , Void
+  , (.>)
+  , (&)
+
+  -- * Others
+  , sync
+  , module Core
+  ) where
+
+import Data.Text as T
+import Data.Set (Set)
+import Data.Void
+import Data.Function
+import Control.Exception (throwIO)
+import Control.Monad.Free (liftF)
+
+import Data.Crjdt.Context as Core
+import Data.Crjdt.Types as Core
+
+import qualified Data.Crjdt.Eval as Eval (execute, eval)
+import Data.Crjdt.Eval as Core hiding (execute, eval)
+
+import Data.Crjdt.Internal
+
+(.>) :: b -> (b -> a) -> a
+(.>) = (&)
+
+infixl 4 .>
+
+-- |'emptyMap' corresponds to {}.
+emptyMap :: Val
+emptyMap = EmptyObject
+
+-- |'emptyList' corresponds to [].
+emptyList :: Val
+emptyList = EmptyArray
+
+-- |Apply commands received from other replicas to current replica.
+yield :: Command ()
+yield = liftF (Yield ())
+
+{-| String literal.
+
+  @
+    'doc' '.>' "planet" '.=' 'string' \"Earth\"
+  @
+
+-}
+string :: Text -> Val
+string = StringLit
+
+{-| Starts iterating over the list.
+
+  @
+    do
+     let planetList = 'doc' '.>' "planet" .> 'iter'
+     insert \"Earth\" planetList
+  @
+
+-}
+iter :: Expr -> Expr
+iter = Iter
+
+{-| Moves to the next element in the list.
+-}
+next :: Expr -> Expr
+next = Next
+
+{-| Get value of given key in given expression.
+-}
+key :: Key Void -> Expr -> Expr
+key = flip GetKey
+
+{-| The root of the JSON object.
+-}
+doc :: Expr
+doc = Doc
+
+-- |Variable.
+var :: Text -> Expr
+var = Var . Variable
+
+-- |Insert a @Val@ in the list.
+insert :: Val -> Expr -> Command ()
+insert v e = liftF (InsertAfter e v ())
+
+-- |Delete the list element.
+delete :: Expr -> Command ()
+delete e = liftF (Delete e ())
+
+-- |Get all keys of object pointed by given 'Expr'.
+keys :: Expr -> Command (Set (Key Void))
+keys e = liftF (Keys e id)
+
+-- |Get all values of object pointed by given 'Expr'.
+values :: Expr -> Command [Val]
+values e = liftF (Values e id)
+
+-- |Assign value to the key pointed by given 'Expr'.
+assign, (=:) :: Expr -> Val -> Command ()
+assign e v = liftF (Assign e v ())
+(=:) = assign
+
+infixr 5 =:
+
+-- |Let binding.
+bind, (-<) :: Text -> Expr -> Command Expr
+bind t e = liftF (Let t e id)
+(-<) = bind
+
+-----------------------------------------------------------------------------------------------
+-- Utility functions
+
+sync :: (ReplicaId, Command ()) -> (ReplicaId, Command ()) -> IO (Eval (), Eval ())
+sync (rid1, first) (rid2, second) =
+  let (rFirst, sFirst) = run rid1 (Eval.execute first)
+      (rSecond, sSecond) = run rid2 (Eval.execute second)
+      synced which replica = do
+        Eval.execute which
+        addReceivedOps (queue replica)
+        Eval.execute yield
+  in case (rFirst *> rSecond) of
+    Right () -> pure $ (synced first sSecond, synced second sFirst)
+    Left ex -> throwIO ex
diff --git a/src/Data/Crjdt/Context.hs b/src/Data/Crjdt/Context.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Crjdt/Context.hs
@@ -0,0 +1,274 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Data.Crjdt.Context
+  ( Context(..)
+  , Cursor(..)
+  , Operation(..)
+  , Tag(..)
+  , Mutation(..)
+  , Document(..)
+  , Branch(..)
+  , RegDocument(..)
+  , findChild
+  , applyOp
+  , getPresence
+  , setPath
+  , setFinalKey
+  , lookupCtx
+  , appendWith
+  , docKey
+  , stepNext
+  ) where
+
+import Data.Void
+import Data.Foldable as Foldable (toList)
+import Data.Maybe
+import Data.Sequence (ViewL(..), viewl)
+import qualified Data.Sequence as Seq
+import Data.Map as M
+import Data.Set as Set
+import Control.Monad.State
+
+import Data.Crjdt.Types
+import Data.Crjdt.Internal.Core
+
+data Tag
+  = MapT
+  | ListT
+  | RegT
+  deriving (Show, Eq, Ord)
+
+data Context = Context
+  { document :: Document Tag
+  , variables :: M.Map Var Cursor
+  , replicaId :: ReplicaId
+  , replicaGlobal :: GlobalReplicaCounter
+  , history :: Set Id
+  , queue :: Seq.Seq Operation
+  , received :: Seq.Seq Operation
+  } deriving Show
+
+data Cursor = Cursor
+  { path :: Seq.Seq (Key Tag)
+  , finalKey :: Key Void
+  } deriving (Show, Eq)
+
+docKey :: Key Tag
+docKey = tagWith MapT DocKey
+
+appendWith :: Tag -> Key Void -> Cursor -> Cursor
+appendWith t k (Cursor p final) = Cursor (p `mappend` Seq.singleton (reTag t final)) k
+
+-- Avoiding lens dependency for now
+setFinalKey :: Key Void -> Cursor -> Cursor
+setFinalKey fk c = c { finalKey = fk }
+
+setPath :: Seq.Seq (Key Tag) -> Cursor -> Cursor
+setPath newpath c = c { path = newpath }
+
+-- still avoiding lens, but almost there :-)
+findChild :: Key Tag -> Document Tag -> Maybe (Document Tag)
+findChild t = ((M.lookup t . children) =<<) . branchOf
+
+childGet :: Key Tag -> Document Tag -> Document Tag
+childGet k = fromMaybe (choose (getTag k)) . findChild k
+  where
+    choose MapT = BranchDocument $ Branch mempty mempty mempty MapT
+    choose ListT = BranchDocument $ Branch mempty mempty (M.singleton Head Tail) ListT
+    choose RegT = LeafDocument mempty
+
+lookupCtx :: Var -> Context -> Maybe Cursor
+lookupCtx v = M.lookup v . variables
+
+getPresence :: Key Void -> Document Tag -> Set Id
+getPresence k =  fromMaybe mempty . ((M.lookup k . presence) =<<) . branchOf
+
+next :: Key Void -> Document Tag -> Key Void
+next (Key key) d = Key $ fromMaybe Tail $ next'
+  where
+    next' = branchOf d >>= ensureList >>= M.lookup key . keyOrder
+    ensureList b@Branch{branchTag = ListT} = Just b
+    ensureList _ = Nothing
+next k _ = k
+
+updatePresence :: Key Void -> Set Id -> Document tag -> Document tag
+updatePresence key deps d = fromMaybe d . fmap (BranchDocument . newBranch) . branchOf $ d
+  where newBranch b =
+          if (Set.null deps)
+          then b { presence = M.delete key (presence b) }
+          else b { presence = M.insert key deps $ presence b }
+
+branchOf :: Document tag -> Maybe (Branch tag)
+branchOf (LeafDocument _) = Nothing
+branchOf (BranchDocument b) = Just b
+
+data Mutation
+  = InsertMutation Val
+  | DeleteMutation
+  | AssignMutation Val
+  deriving (Show, Eq)
+
+data Operation = Operation
+  { opId :: Id
+  , opDeps :: Set.Set Id -- TODO:  version-vectors or dotted-version-vectors
+  , opCur :: Cursor
+  , opMutation :: Mutation
+  } deriving (Eq, Show)
+
+newtype RegDocument = RegDocument { registers :: M.Map Id Val } deriving (Show, Eq, Monoid)
+
+data Branch tag = Branch
+  { children :: Map (Key tag) (Document tag)
+  , presence :: Map (Key Void) (Set Id)
+  , keyOrder :: Map BasicKey BasicKey
+  , branchTag :: tag
+  } deriving (Eq, Show)
+
+data Document tag
+  = BranchDocument (Branch tag)
+  | LeafDocument RegDocument
+  deriving (Eq, Show)
+
+clearElem :: Set Id -> Key Void -> State (Document Tag) (Set Id)
+clearElem deps key = do
+  presence <- clearAny deps key
+  presence' <- getPresence key <$> get
+  let newPresence = presence `mappend` presence' Set.\\ deps
+  modify (updatePresence key newPresence)
+  pure (newPresence)
+
+clearAny :: Set Id -> Key Void -> State (Document Tag) (Set Id)
+clearAny deps key = mconcat <$> traverse clearAll [MapT, ListT, RegT]
+  where
+    clearAll t = clear deps (reTag t key)
+
+clear :: Set Id -> Key Tag -> State (Document Tag) (Set Id)
+clear deps key = get >>= (clear' <*> findChild key)
+  where
+    clear' _ Nothing = pure mempty
+    clear' d (Just (LeafDocument reg)) = put (addChild key (LeafDocument $ RegDocument c) d) *> pure (M.keysSet c)
+      where c = M.filterWithKey (\k _ -> k `Set.notMember` deps) $ registers reg
+    clear' d (Just b)  = fromMaybe (pure mempty) (fmap (clearBranch d) (branchOf b >>= (`chooseClear` b) . branchTag))
+    {-# INLINE clear' #-}
+
+    chooseClear ListT = Just . clearList
+    chooseClear MapT = Just . clearMap
+    chooseClear RegT = const Nothing
+
+    clearBranch d clearWhich = do
+      presence <- clearWhich deps
+      modify (\d' -> addChild key d' d)
+      pure presence
+    {-# INLINE clearBranch #-}
+
+stepNext :: Document Tag -> Cursor -> Cursor
+stepNext d c@(Cursor (viewl -> Seq.EmptyL) (next -> getNextKey)) =
+  let nextKey = getNextKey d
+      newCur = Cursor mempty nextKey
+  in case (nextKey /= Key Tail, Set.null (getPresence nextKey d)) of
+    (True, True) -> stepNext d newCur
+    (True, False) -> newCur
+    (False, _) -> c
+
+stepNext d c@(Cursor (viewl -> (x :< xs)) _) = maybe c f (findChild x d)
+  where f nd = setFinalKey (finalKey $ stepNext nd (setPath xs c)) c
+stepNext _ c = c
+
+addChild :: Key Tag -> Document Tag -> Document Tag -> Document Tag
+addChild _ _ d@(LeafDocument _) = d
+addChild key child (BranchDocument d) = BranchDocument d { children = M.insert key child (children d)}
+
+clearMap, clearList :: Document Tag -> Set Id -> State (Document Tag) (Set Id)
+clearMap child deps = put child *> clearMap' mempty
+  where
+    clearMap' acc = do
+      ms <- allKeys <$> get
+      case Set.toList (ms Set.\\ acc) of
+        [] -> pure mempty
+        (k: _) -> do
+          p1 <- clearElem deps (unTag k)
+          p2 <- clearMap' (Set.insert k acc)
+          pure (p1 `mappend` p2)
+    allKeys (BranchDocument (Branch {branchTag = MapT, ..})) = keysSet children
+    allKeys _ = mempty
+
+clearList child deps = put child *> clearList' (Key Head)
+  where
+    clearList' (Key Tail) = pure mempty
+    clearList' hasMore = do
+      nextt <- next hasMore <$> get
+      p1 <- clearElem deps hasMore
+      p2 <- clearList' nextt
+      pure (p1 `mappend` p2)
+
+addId :: Mutation -> Key Tag -> Id -> Document Tag -> Document Tag
+addId DeleteMutation _ _ d = d
+addId _ t i (BranchDocument b) = BranchDocument b
+  { presence = M.alter (maybe (Just $ Set.singleton i) (Just . Set.insert i)) (unTag t) $ presence b }
+addId _ _ _ d = d
+
+applyOp :: Operation -> Document Tag -> Document Tag
+applyOp o@Operation{..} d = case viewl (path opCur) of
+  EmptyL -> case opMutation of
+    AssignMutation val -> case val of
+      EmptyObject -> assignBranch MapT d
+      EmptyArray -> assignBranch ListT d
+      other -> assignLeaf other d
+      where
+        assignBranch tag = execState $ do
+          let key@(Key k) = finalKey opCur
+              tagged = tagWith tag k
+          void $ clearElem opDeps key
+          modify $ addId opMutation tagged opId
+          child <- childGet tagged <$> get
+          modify (addChild tagged child)
+        assignLeaf other = execState $ do
+          let tagged = tagWith RegT (basicKey $ finalKey opCur)
+          void $ clear opDeps tagged
+          modify $ addId opMutation tagged opId
+          child <- childGet tagged <$> get
+          case child of
+            LeafDocument (RegDocument vals) -> do
+              modify (addChild tagged $ LeafDocument $ RegDocument (M.insert opId other vals))
+
+            branchChild -> modify (addChild tagged branchChild)
+
+    InsertMutation val -> insert' nextKey
+      where
+        key = finalKey opCur
+        nextKey = next key d
+        insertNext =
+          let newDoc = applyOp o
+                { opCur = setPath mempty . setFinalKey (Key $ I opId) $ opCur
+                , opMutation = AssignMutation val
+                } d
+          in case newDoc of
+               BranchDocument b@Branch{branchTag = ListT} -> BranchDocument $ b
+                 { keyOrder = M.insert (I opId) (basicKey nextKey) . M.insert (basicKey key) (I opId) $ keyOrder b}
+               nd -> nd
+
+        insert' k@(Key (I kid))
+          | kid < opId = applyOp (o { opCur = setPath mempty . setFinalKey k $ opCur}) d
+        insert' _ = insertNext
+
+    DeleteMutation -> execState (clearElem opDeps (finalKey opCur)) d
+
+  (x :< xs) ->
+    let c = childGet x d
+        child = applyOp (o {opCur = setPath xs opCur}) c
+        newDoc = addId opMutation x opId d
+    in addChild x child newDoc
diff --git a/src/Data/Crjdt/Eval.hs b/src/Data/Crjdt/Eval.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Crjdt/Eval.hs
@@ -0,0 +1,156 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Data.Crjdt.Eval
+  ( Eval(..)
+  , EvalError(..)
+  , addReceivedOps
+  , run
+  , evalEval
+  , execEval
+  , addVariable
+  , execute
+  , eval
+  ) where
+
+import Data.Void
+import Data.Sequence (ViewL(..), viewl)
+import qualified Data.Sequence as Seq
+import Data.Map as M
+import Data.Maybe (fromMaybe)
+import Data.Set as Set
+import Data.Foldable (traverse_)
+
+import Control.Exception (Exception)
+import Control.Monad.Fix
+import Control.Monad.State
+import Control.Monad.Except
+import Control.Monad.Free (iterM)
+
+import Data.Crjdt.Types
+import Data.Crjdt.Context
+import Data.Crjdt.Internal.Core
+
+data EvalError
+  = GetOnHead
+  | UndefinedVariable Var
+  deriving (Show, Eq)
+
+instance Exception EvalError
+
+newtype Eval a = Eval
+  { runEval :: ExceptT EvalError (State Context) a
+  } deriving
+  ( Functor
+  , Applicative
+  , Monad
+  , MonadFix
+  , MonadError EvalError
+  , MonadState Context
+  )
+
+type Result = Cursor
+
+initial :: ReplicaId -> Context
+initial rid = Context
+  { document = BranchDocument (Branch mempty mempty mempty MapT)
+  , replicaGlobal = 0
+  , variables = mempty
+  , replicaId = rid
+  , queue = mempty
+  , history = mempty
+  , received = mempty
+  }
+
+type Ctx m = (MonadError EvalError m, MonadState Context m)
+
+run :: ReplicaId -> Eval a -> (Either EvalError a, Context)
+run rid = (`runState` (initial rid)) . runExceptT . runEval
+
+evalEval :: ReplicaId -> Expr -> Either EvalError Cursor
+evalEval rid = (`evalState` (initial rid)) . runExceptT . runEval . eval
+
+execEval :: ReplicaId -> Eval a -> Context
+execEval rid = (`execState` (initial rid)) . runExceptT . runEval
+
+valuesOf :: Ctx m => Expr -> m [Val]
+valuesOf e = partsOf e RegT $ \case
+  (LeafDocument l) -> M.elems (registers l)
+  _ -> mempty
+
+keysOf :: Ctx m => Expr -> m (Set.Set (Key Void))
+keysOf e = partsOf e MapT $ \case
+  (BranchDocument (Branch{branchTag = MapT,..})) -> M.keysSet $ M.filter (not . Set.null) presence
+  _ -> mempty
+
+partsOf :: (Ctx m, Monoid a) => Expr -> Tag -> (Document Tag -> a) -> m a
+partsOf e tag f = eval e >>= \c -> partsOf' c f . document <$> get
+  where
+    partsOf' :: Monoid m => Cursor -> (Document Tag -> m) -> Document Tag -> m
+    partsOf' Cursor{..} getParts d = fromMaybe mempty $ case viewl path of
+      EmptyL -> getParts <$> findChild (tagWith tag $ basicKey finalKey) d
+      (x :< xs) -> partsOf' (Cursor xs finalKey) getParts <$> findChild x d
+
+addVariable :: Ctx m => Var -> Cursor -> m ()
+addVariable v cur = modify $ \c -> c { variables = M.insert v cur (variables c)}
+{-# INLINE addVariable #-}
+
+addReceivedOps :: MonadState Context m => Seq.Seq Operation -> m ()
+addReceivedOps ops = modify (\ctx -> ctx {received = ops `mappend` (received ctx)})
+
+applyRemote :: Ctx m => m ()
+applyRemote = get >>= \c ->
+  let alreadyProcessed op cc = opId op `Set.member` history cc
+      satisfiesDeps op cc = opDeps op `Set.isSubsetOf` history cc
+      applyRemote' op = do
+        cc <- get
+        when (not (alreadyProcessed op cc) && satisfiesDeps op cc) $ put cc
+          { replicaGlobal = replicaGlobal cc `max` (sequenceNumber . opId $ op)
+          , document = applyOp op (document cc)
+          , history = Set.insert (opId op) (history cc)
+          }
+  in traverse_ applyRemote' (received c)
+{-# INLINE applyRemote #-}
+
+applyLocal :: Ctx m => Mutation -> Cursor -> m ()
+applyLocal mut cur = modify $ \c ->
+  let op = Operation
+        { opId = mkId (replicaGlobal c + 1) (replicaId c)
+        , opDeps = history c
+        , opCur = cur
+        , opMutation = mut
+        }
+  in c { document = applyOp op (document c)
+       , replicaGlobal = replicaGlobal c + 1
+       , history = Set.insert (opId op) (history c)
+       , queue = queue c Seq.|> op
+       }
+{-# INLINE applyLocal #-}
+
+eval :: Ctx m => Expr -> m Result
+eval Doc = pure $ Cursor Seq.empty $ unTag docKey
+eval (GetKey expr k) = do
+  cursor <- eval expr
+  case finalKey cursor of
+    (Key Head) -> throwError GetOnHead
+    _ -> pure (appendWith MapT k cursor)
+eval (Var var) = get >>= maybe (throwError (UndefinedVariable var)) pure . lookupCtx var
+eval (Iter expr) = appendWith ListT (Key Head) <$> eval expr
+eval (Next expr) = get >>= \(document -> d) -> stepNext d <$> eval expr
+
+execCmd :: Ctx m => Cmd (m a) -> m a
+execCmd (Let x expr c) = (eval expr >>= \cur -> addVariable (Variable x) cur *> pure (Var $ Variable x)) >>= c
+execCmd (Assign expr v c) = (eval expr >>= applyLocal (AssignMutation v)) >> c
+execCmd (InsertAfter expr v c) = (eval expr >>= applyLocal (InsertMutation v)) >> c
+execCmd (Delete expr c) = (eval expr >>= applyLocal DeleteMutation) >> c
+execCmd (Yield c) = applyRemote >> c
+execCmd (Values expr c) = valuesOf expr >>= c
+execCmd (Keys expr c) = keysOf expr >>= c
+
+execute :: Ctx m => Command a -> m a
+execute = iterM execCmd . runCommand
diff --git a/src/Data/Crjdt/Internal.hs b/src/Data/Crjdt/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Crjdt/Internal.hs
@@ -0,0 +1,5 @@
+module Data.Crjdt.Internal
+  ( module Core
+  ) where
+
+import Data.Crjdt.Internal.Core as Core
diff --git a/src/Data/Crjdt/Internal/Core.hs b/src/Data/Crjdt/Internal/Core.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Crjdt/Internal/Core.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Data.Crjdt.Internal.Core where
+
+import Data.Text
+import Data.Void
+import Data.Set (Set)
+import Control.Monad.Free
+import Control.Applicative
+import Data.String
+
+import Data.Crjdt.Types
+
+data Val
+  = Number Int
+  | StringLit Text
+  | BoolLit Bool
+  | Null
+  | EmptyObject
+  | EmptyArray
+  deriving (Show, Eq)
+
+instance IsString Val where
+  fromString = StringLit . pack
+
+data Cmd a
+  = Let !Text !Expr (Expr -> a)
+  | Assign !Expr !Val a
+  | InsertAfter !Expr !Val a
+  | Delete !Expr a
+  | Values !Expr ([Val] -> a)
+  | Keys !Expr (Set (Key Void) -> a)
+  | Yield a
+  deriving Functor
+
+newtype Command a = Command { runCommand :: Free Cmd a }
+  deriving
+    ( Functor
+    , Applicative
+    , Monad
+    , MonadFree Cmd
+    )
+
+data Expr
+  = Doc
+  | Var !Var
+  | Iter !Expr
+  | Next !Expr
+  | GetKey !Expr !(Key Void)
+  deriving (Show, Eq)
+
+instance IsString Expr where
+  fromString = Var . fromString
diff --git a/src/Data/Crjdt/Types.hs b/src/Data/Crjdt/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Crjdt/Types.hs
@@ -0,0 +1,88 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Data.Crjdt.Types where
+
+import Data.String
+import Data.Text
+import Data.Void
+
+newtype Var = Variable { getName :: Text } deriving (Show, Eq, Ord)
+
+instance IsString Var where
+  fromString = Variable . fromString
+
+data TaggedKey tag = TK
+  { tag :: !tag
+  , getKey :: !BasicKey
+  } deriving (Eq, Ord, Functor, Foldable, Traversable)
+
+instance Show tag => Show (TaggedKey tag) where
+  show (TK t k) = show (t, k)
+
+-- TODO: rethink about this type
+data Key tag where
+  Key :: BasicKey -> Key Void
+  TaggedKey :: TaggedKey tag -> Key tag
+
+data BasicKey
+  = DocKey
+  | Head
+  | Tail
+  | I Id
+  | Str Text
+  deriving (Show, Eq, Ord)
+
+instance (Ord tag, Eq tag) => Ord (Key tag) where
+  (Key k) `compare` (Key k1) = k `compare` k1
+  (TaggedKey k) `compare` (TaggedKey k1) = k `compare` k1
+
+instance IsString (Key Void) where
+  fromString = Key . Str . fromString
+
+instance Show tag => Show (Key tag) where
+  show (Key t) = show t
+  show (TaggedKey taggedKey) = show taggedKey
+
+instance Eq tag => Eq (Key tag) where
+  (Key t) == (Key t1) = t == t1
+  (TaggedKey t) == (TaggedKey t1) = t == t1
+  (Key _) == (TaggedKey _) = False
+  (TaggedKey _) == (Key _) = False
+
+type ReplicaId = Integer
+type GlobalReplicaCounter = Integer
+
+newtype Id = Id { getId :: (GlobalReplicaCounter, ReplicaId) } deriving (Eq, Ord)
+
+instance Show Id where
+  show = show . getId
+
+sequenceNumber = fst . getId
+replicaNumber = snd . getId
+
+mkId sn rid = Id (sn, rid)
+
+tagWith :: tag -> BasicKey -> Key tag
+tagWith t = TaggedKey . TK t
+
+getTag :: Key tag -> tag
+getTag (TaggedKey (TK t _)) = t
+
+basicKey :: Key tag -> BasicKey
+basicKey (Key k) = k
+basicKey (TaggedKey (TK _ k)) = k
+
+unTag :: Key tag -> Key Void
+unTag (Key k) = Key k
+unTag (TaggedKey (TK _ k)) = Key k
+
+reTag :: a -> Key Void -> Key a
+reTag given (Key k) = tagWith given k
+reTag given (TaggedKey (TK _ k)) = tagWith given k
diff --git a/test/Data/CrjdtSpec.hs b/test/Data/CrjdtSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Data/CrjdtSpec.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Data.CrjdtSpec where
+
+import Test.Hspec
+import Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+import Data.Map as M hiding (empty)
+import Data.Either (isRight)
+import Data.Maybe
+import Data.Bifunctor
+import Data.Foldable
+import Data.Functor
+import Control.Applicative (liftA2)
+import Control.Monad
+
+import Data.Crjdt
+import Data.Crjdt.Internal
+
+eitherToMaybe :: Either x a -> Maybe a
+eitherToMaybe (Right a) = Just a
+eitherToMaybe _ = Nothing
+
+-- allProps :: IO ()
+-- allProps = traverse_ check [property_let, property_var]
+
+twenty = Range.linear 0 20
+
+keyGen :: Monad m => Gen m BasicKey
+keyGen = Gen.choice $ (pure <$> [Head, Tail, DocKey]) ++
+  [ I . Id <$> (liftA2 (fmap (bimap toInteger toInteger) . (,)) naturals naturals)
+  , Str <$> Gen.text twenty Gen.hexit
+  ]
+
+naturals :: Monad m => Gen m Int
+naturals = Gen.int (Range.linear 0 1000)
+
+exprGen :: Gen IO Expr
+exprGen = Gen.recursive Gen.choice terminal nonterminal
+  where
+    terminal = [pure doc]
+    letVar = Gen.text twenty Gen.hexit >>= \t -> Let t <$> exprGen
+    nonterminal =
+      [ iter <$> exprGen
+      , next <$> exprGen
+      , key <$> (Key <$> keyGen) <*> exprGen
+      ]
+
+property_let :: Property
+property_let = property $ do
+  expr <- forAll exprGen
+  name <- Variable <$> (forAll $ Gen.text twenty Gen.hexit)
+  let (result, state) = run 1 $ execute $ bind (getName name) expr
+  when (isRight result) $ do
+    let Just cursor = M.lookup name $ variables $ state
+        Right expectedCursor = evalEval 1 expr
+    cursor === expectedCursor
+
+property_var :: Property
+property_var = property $ do
+  expr <- forAll exprGen
+  x <- Variable <$> (forAll $ Gen.text twenty Gen.hexit)
+  let (result, c) = run 1 $ execute (bind (getName x) expr) *> eval (Var x)
+      v = M.lookup x (variables c)
+  v === eitherToMaybe result
+
+property_get :: Property
+property_get = property $ do
+  expr <- forAll exprGen
+  k <- forAll keyGen
+  let cursor = evalEval 1 (GetKey expr $ Key k)
+  when (k /= Head && isRight cursor) $ fmap finalKey cursor === Right (Key k)
+
+checkH :: Property -> IO ()
+checkH = void . check
+
+spec :: Spec
+spec = describe "Crjdt Specs" $
+  describe "Expr evaluation" $ do
+    it "DOC" $ evalEval 1 Doc `shouldBe` Right (Cursor mempty (Key DocKey))
+    it "LET" $ checkH property_let
+    it "VAR" $ checkH property_var
+    it "GET" $ checkH property_get
diff --git a/test/Data/FigureSpec.hs b/test/Data/FigureSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Data/FigureSpec.hs
@@ -0,0 +1,178 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Data.FigureSpec where
+
+import Test.Hspec
+
+import Data.Map as Map hiding (insert, keys)
+import Data.Set as Set
+import Control.Monad.State
+
+import Data.Crjdt as C
+import Data.Crjdt.Internal
+
+spec :: Spec
+spec = describe "Figures from CRJDT paper" $ do
+  let putRemote ops = modify (\ctx -> ctx { received = ops `mappend` (received ctx)})
+
+  it "Figure 1" $ do
+    let
+      initial = execute (key "key" doc =: "A")
+      r1 = initial
+      r2 = initial
+      r1next = r1 *> execute (key "key" doc =: "C")
+      r2next = r2 *> execute (key "key" doc =: "D")
+
+      (fr, firstState) = run 1 r1next
+      (sr, secondState) = run 2 r2next
+
+      r1yield = r1next *> putRemote (queue secondState) *> execute yield
+      r2yield = r2next *> putRemote (queue firstState) *> execute yield
+
+      (rr, r1Result) = run 1 r1yield
+      (r2r, r2Result) = run 2 r2yield
+
+    _ <- traverse (\x -> x `shouldBe` Right ()) [fr, sr, rr, r2r]
+
+    document firstState `shouldSatisfy` (/= (document secondState))
+    document r1Result `shouldBe` document r2Result
+    history r1Result `shouldBe` history r2Result
+
+    let
+      p = Set.fromList [mkId 1 1, mkId 1 2, mkId 2 1, mkId 2 2]
+      docPresence = Map.fromList [(Key DocKey, p)]
+      keyPresence = Map.fromList [("key", p)]
+      leaf = RegDocument $ Map.fromList $ [(mkId 2 1, "C"),(mkId 2 2, "D")]
+
+      innerMap = Branch
+        { children = Map.fromList [(tagWith RegT (Str "key"), LeafDocument leaf)]
+        , presence = keyPresence
+        , keyOrder = mempty
+        , branchTag = MapT
+        }
+
+      parent = Branch
+        { children = Map.fromList [(tagWith MapT DocKey, BranchDocument innerMap)]
+        , presence = docPresence
+        , keyOrder = mempty
+        , branchTag = MapT
+        }
+
+      d = BranchDocument parent
+
+    document r1Result `shouldBe` d
+
+  it "Figure 2" $ do
+    let r1 = do
+          var <- bind "var" (key "colors" doc)
+          key "blue" var =: "#0000ff"
+
+        (_, r1result) = run 1 $ execute r1
+
+        r1next = do
+          r1
+          key "red" "var" =: "#ff0000"
+
+        r2next = putRemote (queue r1result) *> execute yield *> execute (do
+            key "colors" doc =: emptyMap
+            key "green" (key "colors" doc) =: "#00ff00”"
+          )
+
+        (r1r, r1State) = run 1 $ execute (r1next *> keys (key "colors" doc))
+        (r2r, r2State) = run 2 (r2next *> execute (keys (key "colors" doc)))
+
+        r1Final = execute r1next *> putRemote (queue r2State) *> execute (yield *> keys (key "colors" doc))
+        r2Final = r2next *> putRemote (queue r1State) *> execute (yield *> keys (key "colors" doc))
+
+        (Right keys1, finalResult1) = run 1 r1Final
+        (Right keys2, finalResult2) = run 2 r2Final
+
+    keys1 `shouldBe` keys2
+    keys1 `shouldBe` Set.fromList ["red", "green"]
+
+    document finalResult1 `shouldBe` document finalResult2
+    history finalResult1 `shouldBe` history finalResult2
+
+  it "Figure 3" $ do
+    let cmd1 = do
+          key "grocery" doc =: emptyList
+          C.insert "eggs" (iter $ key "grocery" doc)
+          eggs <- bind "eggs" (next (iter (key "grocery" doc)))
+          C.insert "ham" eggs
+
+    let cmd2 = do
+          key "grocery" doc =: emptyMap
+          C.insert "milk" (iter (key "grocery" doc))
+          milk <- bind "milk" (next (iter (key "grocery" doc)))
+          C.insert "flour" milk
+    let (Right (), r1State) = run 1 $ execute cmd1
+        (Right (), r2State) = run 2 $ execute cmd2
+
+    let getValues = do
+          eggs <- values "eggs"
+          milk <- values (next $ "eggs")
+          ham <- values (next $ next $ "eggs")
+          flour <- values (next $ next $ next $ "eggs")
+          pure (eggs ++ milk ++ ham ++ flour)
+
+    let (Right xs, r1Final) = run 1 (execute cmd1 *> putRemote (queue r2State) *> execute (yield *> getValues))
+        (Right (), r2Final) = run 2 (execute cmd2 *> putRemote (queue r1State) *> execute yield)
+
+
+    xs `shouldBe` ["eggs", "milk", "ham", "flour"]
+
+    document r1Final  `shouldBe` document r2Final
+    -- grocery `shouldBe` expectedGrocery
+
+  describe "Empty updates" $ do
+    let test what = do
+          let cmd = key "g" doc =: what
+              cmd1 = cmd
+              (Right (), r) = run 1 $ execute cmd
+              (Right (), r1) = run 2 $ execute cmd1
+
+          let (Right (), x1) = run 1 (execute cmd *> putRemote (queue r1) *> execute yield)
+              (Right (), x2) = run 2 (execute cmd1 *> putRemote (queue r) *> execute yield)
+
+          document x1 `shouldBe` document x2
+
+    it "Empty object update" $ test emptyMap
+    it "Empty list update" $ test emptyList
+
+  it "Figure 4" $ do
+    let cmd = do
+          todo <- "todo" -< iter (key "todo" doc)
+          C.insert emptyMap "todo"
+          key "title" (next $ "todo") =: "buy milk"
+          key "done" (next $ "todo") =: "false"
+
+        (Right (), cmdResult) = run 1 $ execute cmd
+        r1next = cmd *> C.delete (next $ "todo")
+        r2 = key "done" (next $ iter $ key "todo" doc) =: "true"
+        r2next = putRemote (queue cmdResult) *> execute yield *> execute r2
+        (Right (), r1St) = run 1 $ execute r1next
+        (Right (), r2St) = run 2 $ r2next
+
+        (Right keys1, r1Final) = run 1 (execute r1next *> putRemote (queue r2St) *> execute (yield *> keys (next $ iter $ key "todo" doc)))
+        (Right keys2, r2Final) = run 2 (r2next *> putRemote (queue r1St) *> execute (yield *> keys (next $ iter $ key "todo" doc)))
+
+    keys1 `shouldBe` keys2
+    keys1 `shouldBe` Set.fromList ["done"]
+    document r1Final `shouldBe` document r2Final
+
+  it "Figure 6" $ do
+    let cmd = do
+          doc =: emptyMap
+          list <- bind "list" $ doc .> key "shopping" .> iter
+          C.insert "eggs" list
+          eggs <- bind "eggs" (next list)
+          C.insert "milk" eggs
+          C.insert "cheese" list
+
+        (Right xs, _) = run 1 $ execute $ cmd *> do
+          eggs <- values "eggs"
+          milk <- values ("eggs" .> next)
+          cheese <- values ("eggs" .> next .> next)
+          pure (eggs ++ milk ++ cheese)
+
+    xs `shouldBe` ["eggs", "milk", "cheese"]
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}