From 697728c9a671d96c39126ae2b0734ff1054b364a Mon Sep 17 00:00:00 2001
From: Yuriy Syrovetskiy <cblp@cblp.su>
Date: Fri, 12 Apr 2019 10:29:25 +0300
Subject: [PATCH] WIP

---
 CMakeLists.txt                |  1 +
 swarm/lib/Swarm/DB/Replica.hs |  9 +++++-
 swarm/swarm.cabal             |  9 +++++-
 swarm/test/Main.hs            | 59 +++++++++++++++++++++++++++--------
 4 files changed, 63 insertions(+), 15 deletions(-)

diff --git a/CMakeLists.txt b/CMakeLists.txt
index d2fbe4c4..8649ef43 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -4,6 +4,7 @@ include(ExternalProject)
 set(RON_CXX_INSTALL_DIR "${CMAKE_SOURCE_DIR}/swarm/_artifacts/")
 ExternalProject_Add(
     ron-cxx
+    # GIT_REPOSITORY /Users/cblp/dev/ron-cxx
     GIT_REPOSITORY https://github.com/gritzko/ron-cxx.git
     GIT_TAG master
     CMAKE_ARGS -DCMAKE_INSTALL_PREFIX:PATH=${RON_CXX_INSTALL_DIR}
diff --git a/swarm/lib/Swarm/DB/Replica.hs b/swarm/lib/Swarm/DB/Replica.hs
index 891b60f8..e60f8467 100644
--- a/swarm/lib/Swarm/DB/Replica.hs
+++ b/swarm/lib/Swarm/DB/Replica.hs
@@ -1,12 +1,19 @@
+{-# OPTIONS -Wno-unused-imports #-}
+
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeOperators #-}
 
 module Swarm.DB.Replica
   ( TextReplica,
     createReplica,
+    getObject,
     newTextReplica,
     open,
     receive,
@@ -30,7 +37,7 @@ import qualified Swarm.RON.Status as Status
 import Swarm.RON.Text (TextFrame)
 
 -- | Class @ron::Replica<TextFrame>@
-newtype TextReplica = TextReplica (ForeignPtr (Proxy TextReplica))
+newtype TextReplica = TextReplica (Ptr (Proxy TextReplica))
 
 do
   context $
diff --git a/swarm/swarm.cabal b/swarm/swarm.cabal
index 4386e683..a1ca7d61 100644
--- a/swarm/swarm.cabal
+++ b/swarm/swarm.cabal
@@ -21,6 +21,7 @@ flag swarm
 
 common language
     build-depends: base >= 4.10 && < 4.13
+    default-extensions: MonadFailDesugaring NoImplicitPrelude
     default-language: Haskell2010
     if flag(swarm)
         buildable: True
@@ -35,6 +36,8 @@ library
         containers,
         inline-c,
         inline-c-cpp,
+        named,
+        resourcet,
         -- project
         ron,
     ghc-options: -optc=-std=c++11
@@ -63,11 +66,15 @@ test-suite test
     build-depends:
         -- global
         hedgehog,
+        mmorph,
+        monad-control,
+        mtl,
+        resourcet,
         tasty-hedgehog,
         tasty-th,
+        unliftio-core,
         -- project
         ron,
-        ron-rdt,
         ron-test,
         -- package
         swarm,
diff --git a/swarm/test/Main.hs b/swarm/test/Main.hs
index da997488..659153a2 100644
--- a/swarm/test/Main.hs
+++ b/swarm/test/Main.hs
@@ -1,30 +1,63 @@
-{-# OPTIONS -Wno-missing-signatures #-}
+{-# OPTIONS -Wwarn=missing-signatures #-}
+{-# OPTIONS -Wwarn=unused-imports #-}
+{-# OPTIONS -Wwarn=unused-matches #-}
 
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Main (main) where
 
+import           RON.Prelude
+
 import           Control.Monad.IO.Class (liftIO)
-import           Hedgehog (failure, forAll, property, success, (===))
+import           Control.Monad.Morph (hoist)
+import           Control.Monad.Trans.Resource (runResourceT)
+import           Hedgehog (evalEither, forAll, property, test, (===))
 import           Test.Tasty.Hedgehog (testProperty)
 import           Test.Tasty.TH (defaultMainGenerator)
 
 import qualified Gen
-import           RON.Data.LWW (lwwType)
 
-import           Swarm.DB.Replica (newTextReplica, receive)
-import           Swarm.RON.Status (Status (Status), code, notOpen)
+import           Swarm.DB.Replica (createBranch, createObject, createReplica,
+                                   getObject, newTextReplica, open)
+import           Swarm.RON.Status (Status (Status), notOpen, ok)
 
 main = $defaultMainGenerator
 
-prop_uninitialized_replica = property $ do
-    replica <- liftIO newTextReplica
-    key <- forAll Gen.uuid
-    liftIO (receive key lwwType replica) >>= \case
-        Left status@Status{code}
-            | code == notOpen -> success
-            | otherwise        -> status === Status notOpen ""
-        Right _ -> failure
+-- prop_uninitialized_replica = property $ do
+--     object <- forAll Gen.uuid
+--     typ    <- forAll Gen.uuid
+--     yarn   <- forAll Gen.word64'
+--     got    <- liftIO . runResourceT $ do
+--         replica <- newTextReplica
+--         liftIO $ getObject (#object object) (#type typ) (#yarn yarn) replica
+--     Left (Status notOpen "") === got
+
+prop_put_get = property $ do
+    typ  <- forAll Gen.uuid
+    yarn <- forAll Gen.word64'
+    hoist runResourceT $ do
+        replica <- lift newTextReplica
+        -- pure ()
+
+        replicaCreated <- liftIO $ createReplica replica
+        Status ok "" === replicaCreated
+
+        replicaOpened <- liftIO $ open replica
+        Status ok "" === replicaOpened
+
+        branchCreated <- liftIO $ createBranch (#yarn yarn) replica
+        Status ok "" === branchCreated
+
+        objectCreated <-
+            liftIO $ createObject (#type typ) (#yarn yarn) replica
+        Right () === objectCreated
+
+        objectGot <- liftIO $
+            getObject (error "objectId") (#type typ) (#yarn yarn) replica
+        value <- evalEither objectGot
+        "value" === value