ron-storage 0.7 → 0.8
raw patch · 7 files changed
+37/−238 lines, 7 files
Files
- CHANGELOG.md +5/−1
- lib/RON/Storage.hs +10/−10
- lib/RON/Storage/Backend.hs +13/−10
- lib/RON/Storage/FS.hs +4/−1
- lib/RON/Storage/Test.hs +2/−0
- prelude/Prelude.hs +0/−189
- ron-storage.cabal +3/−27
CHANGELOG.md view
@@ -6,6 +6,8 @@ [Compatible Versioning](https://github.com/staltz/comver). ## [Unreleased]++## [0.8] - 2019-07-26 ### Added - Module `RON.Storage.Rocks` @@ -118,7 +120,9 @@ - RON-Schema - RON-Schema TemplateHaskell code generator -[Unreleased]: https://github.com/ff-notes/ron/compare/v0.6...HEAD+[Unreleased]: https://github.com/ff-notes/ron/compare/v0.8...HEAD+[0.8]: https://github.com/ff-notes/ron/compare/v0.7...v0.8+[0.7]: https://github.com/ff-notes/ron/compare/v0.6...v0.7 [0.6]: https://github.com/ff-notes/ron/compare/v0.5...v0.6 [0.5]: https://github.com/ff-notes/ron/compare/v0.4...v0.5 [0.4]: https://github.com/ff-notes/ron/compare/v0.3...v0.4
lib/RON/Storage.hs view
@@ -16,9 +16,11 @@ modify, ) where +import RON.Prelude+ import qualified Data.Text as Text -import RON.Data (reduceObject)+import RON.Data (ObjectStateT, execObjectState, reduceObject) import RON.Error (Error (Error), errorContext, throwErrorString) import RON.Storage.Backend (Collection (..), CollectionName, DocId (DocId), Document (Document),@@ -26,7 +28,7 @@ createVersion, decodeDocId, getDocumentVersions, isTouched, readVersion, value, versions)-import RON.Types (Object, UUID)+import RON.Types (ObjectState, UUID) import qualified RON.UUID as UUID data CollectionDocId = forall a. Collection a => CollectionDocId (DocId a)@@ -57,8 +59,8 @@ -- | Validation-like version of 'sconcat'. vsconcat- :: NonEmpty (Either Error (Object a, IsTouched))- -> Either Error (Object a, IsTouched)+ :: NonEmpty (Either Error (ObjectState a, IsTouched))+ -> Either Error (ObjectState a, IsTouched) vsconcat = foldr1 vappend where vappend (Left e1) (Left e2) = Left $ Error "vappend" [e1, e2]@@ -74,16 +76,14 @@ -- | Load document, apply changes and put it back to storage modify- :: (Collection a, MonadStorage m)- => DocId a -> StateT (Object a) m () -> m (Object a)+ :: (Collection a, MonadStorage m) => DocId a -> ObjectStateT a m () -> m () modify docid f = do oldDoc <- loadDocument docid- newObj <- execStateT f $ value oldDoc- createVersion (Just (docid, oldDoc)) newObj- pure newObj+ value' <- execObjectState (value oldDoc) f+ createVersion (Just (docid, oldDoc)) value' -- | Create document assuming it doesn't exist yet.-createDocument :: (Collection a, MonadStorage m) => Object a -> m ()+createDocument :: (Collection a, MonadStorage m) => ObjectState a -> m () createDocument = createVersion Nothing docIdFromUuid :: UUID -> DocId a
lib/RON/Storage/Backend.hs view
@@ -19,15 +19,18 @@ readVersion, ) where +import RON.Prelude+ import qualified Data.ByteString.Lazy.Char8 as BSLC import Data.String (fromString)+import System.FilePath ((</>)) import qualified Text.Show (show) import RON.Data (ReplicatedAsObject) import RON.Error (MonadE, liftMaybe, throwErrorString) import RON.Event (ReplicaClock, getEventUuid) import RON.Text (parseStateFrame, serializeStateFrame)-import RON.Types (Object (Object, frame, id), UUID)+import RON.Types (ObjectState (ObjectState, frame, uuid), UUID) import RON.Util (ByteStringL) import qualified RON.UUID as UUID @@ -52,7 +55,7 @@ collectionName :: CollectionName -- | Called when RON parser fails.- fallbackParse :: MonadE m => UUID -> ByteStringL -> m (Object a)+ fallbackParse :: MonadE m => UUID -> ByteStringL -> m (ObjectState a) fallbackParse _ _ = throwError "no fallback parser implemented" -- | Storage backend interface@@ -86,9 +89,9 @@ -- | Load document version as an object readVersion :: MonadStorage m- => Collection a => DocId a -> DocVersion -> m (Object a, IsTouched)+ => Collection a => DocId a -> DocVersion -> m (ObjectState a, IsTouched) readVersion docid version = do- (isObjectIdValid, id) <-+ (isObjectIdValid, uuid) <- liftMaybe ("Bad Base32 UUID " <> show docid) $ decodeDocId docid unless isObjectIdValid $@@ -96,9 +99,9 @@ contents <- loadVersionContent docid version case parseStateFrame contents of Right frame ->- pure (Object{id, frame}, IsTouched False)+ pure (ObjectState{uuid, frame}, IsTouched False) Left ronError ->- do object <- fallbackParse id contents+ do object <- fallbackParse uuid contents pure (object, IsTouched True) `catchError` \fallbackError -> throwError $ case BSLC.head contents of@@ -112,7 +115,7 @@ -- | Result of DB reading, loaded document with information about its versions data Document a = Document- { value :: Object a+ { value :: ObjectState a -- ^ Merged value. , versions :: NonEmpty DocVersion , isTouched :: IsTouched@@ -126,17 +129,17 @@ . (Collection a, MonadStorage m) => Maybe (DocId a, Document a) -- ^ 'Just', if document exists already; 'Nothing' otherwise.- -> Object a+ -> ObjectState a -> m () createVersion mDoc newObj = case mDoc of- Nothing -> save (DocId @a $ UUID.encodeBase32 id) []+ Nothing -> save (DocId @a $ UUID.encodeBase32 uuid) [] Just (docid, oldDoc) -> do let Document{value = oldObj, versions, isTouched = IsTouched isTouched} = oldDoc when (newObj /= oldObj || length versions /= 1 || isTouched) $ save docid $ toList versions where- Object{id, frame} = newObj+ ObjectState{uuid, frame} = newObj save docid oldVersions = do newVersion <- UUID.encodeBase32 <$> getEventUuid
lib/RON/Storage/FS.hs view
@@ -18,7 +18,7 @@ -- let dataDir = ".\/data\/" -- h <- Storage.'newHandle' dataDir -- 'runStorage' h $ do--- obj <- 'newObject' Note{active = True, text = "Write an example"}+-- obj <- 'newObjectState' Note{active = True, text = "Write an example"} -- 'createDocument' obj -- @ module RON.Storage.FS (@@ -32,6 +32,8 @@ subscribeForever, ) where +import RON.Prelude+ import Control.Concurrent.STM (TChan, atomically, dupTChan, newBroadcastTChanIO, readTChan, writeTChan)@@ -42,6 +44,7 @@ import System.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesPathExist, listDirectory, removeFile, renameDirectory)+import System.FilePath ((</>)) import System.IO.Error (isDoesNotExistError) import RON.Epoch (EpochClock, getCurrentEpochTime, runEpochClock)
lib/RON/Storage/Test.hs view
@@ -7,6 +7,8 @@ module RON.Storage.Test (TestDB, runStorageSim) where +import RON.Prelude+ import qualified Data.ByteString.Lazy.Char8 as BSLC import Data.Functor.Compose (Compose (Compose), getCompose) import Data.Map.Strict ((!), (!?))
− prelude/Prelude.hs
@@ -1,189 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE LambdaCase #-}--module Prelude (- module X,- fmapL,- foldr1,- headMay,- identity,- lastDef,- maximumDef,- maxOn,- minOn,- note,- replicateM2,- replicateM3,- show,- whenJust,- (!!),- (?:),-) where---- base-import Control.Applicative as X (Alternative, Applicative, liftA2,- many, optional, pure, some, (*>),- (<*), (<*>), (<|>))-import Control.Exception as X (Exception, catch, evaluate, throwIO)-import Control.Monad as X (Monad, filterM, guard, unless, void, when,- (<=<), (=<<), (>=>), (>>=))-import Control.Monad.Fail as X (MonadFail, fail)-import Control.Monad.IO.Class as X (MonadIO, liftIO)-import Data.Bifunctor as X (bimap)-import Data.Bool as X (Bool (False, True), not, otherwise, (&&), (||))-import Data.Char as X (Char, chr, ord, toLower, toUpper)-import Data.Coerce as X (Coercible, coerce)-import Data.Data as X (Data)-import Data.Either as X (Either (Left, Right), either)-import Data.Eq as X (Eq, (/=), (==))-import Data.Foldable as X (Foldable, and, asum, fold, foldMap, foldl',- foldr, for_, length, minimumBy, null, or,- toList, traverse_)-import Data.Function as X (const, flip, on, ($), (.))-import Data.Functor as X (Functor, fmap, ($>), (<$), (<$>))-import Data.Functor.Identity as X (Identity)-import Data.Int as X (Int, Int16, Int32, Int64, Int8)-import Data.IORef as X (IORef, atomicModifyIORef', newIORef,- readIORef, writeIORef)-import Data.List as X (drop, filter, genericLength, intercalate,- isPrefixOf, isSuffixOf, lookup, map, partition,- repeat, replicate, sortBy, sortOn, span,- splitAt, take, takeWhile, unlines, unwords,- zip, (++))-import Data.List.NonEmpty as X (NonEmpty ((:|)), nonEmpty)-import Data.Maybe as X (Maybe (Just, Nothing), catMaybes, fromMaybe,- listToMaybe, maybe, maybeToList)-import Data.Monoid as X (Last (Last), Monoid, mempty)-import Data.Ord as X (Down (Down), Ord, Ordering (EQ, GT, LT),- compare, comparing, max, min, (<), (<=), (>),- (>=))-import Data.Ratio as X ((%))-import Data.Semigroup as X (Semigroup, sconcat, (<>))-import Data.String as X (String)-import Data.Traversable as X (for, sequence, sequenceA, traverse)-import Data.Tuple as X (fst, snd, uncurry)-import Data.Typeable as X (Typeable)-import Data.Word as X (Word, Word16, Word32, Word64, Word8)-import GHC.Enum as X (Bounded, Enum, fromEnum, maxBound, minBound,- pred, succ, toEnum)-import GHC.Err as X (error, undefined)-import GHC.Exts as X (Double)-import GHC.Generics as X (Generic)-import GHC.Integer as X (Integer)-import GHC.Num as X (Num, negate, subtract, (*), (+), (-))-import GHC.Real as X (Integral, fromIntegral, mod, realToFrac, round,- (^), (^^))-import GHC.Stack as X (HasCallStack)-import System.IO as X (FilePath, IO)-import Text.Show as X (Show)--#ifdef VERSION_bytestring-import Data.ByteString as X (ByteString)-#endif--#ifdef VERSION_containers-import Data.Map.Strict as X (Map)-#endif--#ifdef VERSION_deepseq-import Control.DeepSeq as X (NFData, force)-#endif--#ifdef VERSION_filepath-import System.FilePath as X ((</>))-#endif--#ifdef VERSION_hashable-import Data.Hashable as X (Hashable, hash)-#endif--#ifdef VERSION_mtl-import Control.Monad.Except as X (ExceptT, MonadError, catchError,- liftEither, runExceptT, throwError)-import Control.Monad.Reader as X (ReaderT (ReaderT), ask, reader,- runReaderT)-import Control.Monad.State.Strict as X (MonadState, State, StateT,- evalState, evalStateT,- execStateT, get, gets,- modify', put, runState,- runStateT, state)-import Control.Monad.Trans as X (MonadTrans, lift)-import Control.Monad.Writer.Strict as X (MonadWriter, WriterT,- runWriterT, tell)-#endif--#ifdef VERSION_text-import Data.Text as X (Text)-#endif--#ifdef VERSION_time-import Data.Time as X (UTCTime)-#endif--#ifdef VERSION_unordered_containers-import Data.HashMap.Strict as X (HashMap)-#endif------------------------------------------------------------------------------------import qualified Data.Foldable-import Data.List (last, maximum)-import Data.String (IsString, fromString)-import qualified Text.Show--fmapL :: (a -> b) -> Either a c -> Either b c-fmapL f = either (Left . f) Right--foldr1 :: (a -> a -> a) -> NonEmpty a -> a-foldr1 = Data.Foldable.foldr1--headMay :: [a] -> Maybe a-headMay = \case- [] -> Nothing- a:_ -> Just a--identity :: a -> a-identity x = x--lastDef :: a -> [a] -> a-lastDef def = list' def last--list' :: b -> ([a] -> b) -> [a] -> b-list' onEmpty onNonEmpty = \case- [] -> onEmpty- xs -> onNonEmpty xs--maximumDef :: Ord a => a -> [a] -> a-maximumDef def = list' def maximum--maxOn :: Ord b => (a -> b) -> a -> a -> a-maxOn f x y = if f x < f y then y else x--minOn :: Ord b => (a -> b) -> a -> a -> a-minOn f x y = if f x < f y then x else y--note :: e -> Maybe a -> Either e a-note e = maybe (Left e) Right--replicateM2 :: Applicative m => m a -> m (a, a)-replicateM2 ma = (,) <$> ma <*> ma--replicateM3 :: Applicative m => m a -> m (a, a, a)-replicateM3 ma = (,,) <$> ma <*> ma <*> ma--show :: (Show a, IsString s) => a -> s-show = fromString . Text.Show.show--whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()-whenJust m f = maybe (pure ()) f m--(!!) :: [a] -> Int -> Maybe a-xs !! i- | i < 0 = Nothing- | otherwise = headMay $ drop i xs---- | An infix form of 'fromMaybe' with arguments flipped.-(?:) :: Maybe a -> a -> a-maybeA ?: b = fromMaybe b maybeA-{-# INLINABLE (?:) #-}-infixr 0 ?:
ron-storage.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: ron-storage-version: 0.7+version: 0.8 bug-reports: https://github.com/ff-notes/ron/issues category: Distributed Systems, Protocol, Database@@ -15,29 +15,7 @@ description: Replicated Object Notation (RON), data types (RDT), and RON-Schema .- Typical usage:- .- > import RON.Data- > import RON.Schema.TH- > import RON.Storage.FS as Storage- >- > [mkReplicated|- > (struct_lww Note- > active Boole- > text RgaString)- > |]- >- > instance Collection Note where- > collectionName = "note"- >- > main :: IO ()- > main = do- > let dataDir = "./data/"- > h <- Storage.newHandle dataDir- > runStorage h $ do- > obj <- newObject- > Note{active = True, text = "Write a task manager"}- > createDocument obj+ Examples: https://github.com/ff-notes/ron/tree/master/examples build-type: Simple @@ -46,10 +24,8 @@ common language build-depends: base >= 4.10 && < 4.13, integer-gmp- default-extensions: MonadFailDesugaring StrictData+ default-extensions: MonadFailDesugaring NoImplicitPrelude StrictData default-language: Haskell2010- hs-source-dirs: prelude- other-modules: Prelude library import: language