ron-storage 0.5 → 0.6

raw patch · 3 files changed

+22/−19 lines, 3 filesdep +stm

Dependencies added: stm

Files

• lib/RON/Storage.hs +5/−1
• lib/RON/Storage/IO.hs +15/−17
• ron-storage.cabal +2/−1

@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-}@@ -9,6 +10,7 @@ -- | RON File Storage. For usage, see "RON.Storage.IO". module RON.Storage (     Collection (..),+    CollectionDocId (..),     CollectionName,     DocId (..),     Document (..),@@ -47,6 +49,8 @@ instance Collection a => Show (DocId a) where     show (DocId file) = collectionName @a </> file +data CollectionDocId = forall a. Collection a => CollectionDocId (DocId a)+ -- | Collection (directory name) type CollectionName = FilePath @@ -190,7 +194,7 @@         let Document{value = oldObj, versions, isTouched = IsTouched isTouched}                 = oldDoc         when (newObj /= oldObj || length versions /= 1 || isTouched) $-            save docid versions+            save docid $ toList versions   where     Object{id, frame} = newObj 

@@ -25,14 +25,17 @@     module X,     -- * Handle     Handle,-    OnDocumentChanged (..),     newHandle,-    setOnDocumentChanged,     -- * Storage     Storage,     runStorage,+    subscribeForever, ) where +import           Control.Concurrent.STM (TChan, atomically, dupTChan,+                                         newBroadcastTChanIO, readTChan,+                                         writeTChan)+import           Control.Monad (forever) import           Data.Bits (shiftL) import qualified Data.ByteString.Lazy as BSL import           Network.Info (MAC (MAC), getNetworkInterfaces, mac)@@ -125,21 +128,13 @@     { hClock             :: IORef EpochTime     , hDataDir           :: FilePath     , hReplica           :: ReplicaId-    , hOnDocumentChanged :: IORef (Maybe OnDocumentChanged)+    , hOnDocumentChanged :: TChan CollectionDocId     } --- | The handler is called as @onDocumentChanged docid@, where--- @docid@ is the changed document id.-newtype OnDocumentChanged =-    OnDocumentChanged (forall a . Collection a => DocId a -> IO ())- emitDocumentChanged :: Collection a => DocId a -> Storage () emitDocumentChanged docid = Storage $ do     Handle{hOnDocumentChanged} <- ask-    liftIO $ do-        mOnDocumentChanged <- readIORef hOnDocumentChanged-        whenJust mOnDocumentChanged $ \(OnDocumentChanged onDocumentChanged) ->-            onDocumentChanged docid+    liftIO . atomically $ writeTChan hOnDocumentChanged $ CollectionDocId docid  -- | Create new storage handle newHandle :: FilePath -> IO Handle@@ -147,13 +142,9 @@     time <- getCurrentEpochTime     hClock <- newIORef time     hReplica <- applicationSpecific <$> getMacAddress-    hOnDocumentChanged <- newIORef Nothing+    hOnDocumentChanged <- newBroadcastTChanIO     pure Handle{hDataDir, hClock, hReplica, hOnDocumentChanged} -setOnDocumentChanged :: Handle -> OnDocumentChanged -> IO ()-setOnDocumentChanged h handler =-    writeIORef (hOnDocumentChanged h) $ Just handler- listDirectoryIfExists :: FilePath -> Storage [FilePath] listDirectoryIfExists relpath = Storage $ do     Handle{hDataDir} <- ask@@ -183,3 +174,10 @@         + fromIntegral b2 `shiftL` 16         + fromIntegral b1 `shiftL` 8         + fromIntegral b0++subscribeForever :: Handle -> (CollectionDocId -> IO ()) -> IO ()+subscribeForever Handle{hOnDocumentChanged} action = do+    childChan <- atomically $ dupTChan hOnDocumentChanged+    forever $ do+        docId <- atomically $ readTChan childChan+        action docId

@@ -1,7 +1,7 @@ cabal-version:  2.2  name:           ron-storage-version:        0.5+version:        0.6  bug-reports:    https://github.com/ff-notes/ron/issues category:       Distributed Systems, Protocol, Database@@ -58,6 +58,7 @@         filepath,         mtl,         network-info,+        stm,         text,         transformers,         -- project