diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/lib/RON/Storage.hs b/lib/RON/Storage.hs --- a/lib/RON/Storage.hs +++ b/lib/RON/Storage.hs @@ -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 diff --git a/lib/RON/Storage/Backend.hs b/lib/RON/Storage/Backend.hs --- a/lib/RON/Storage/Backend.hs +++ b/lib/RON/Storage/Backend.hs @@ -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 diff --git a/lib/RON/Storage/FS.hs b/lib/RON/Storage/FS.hs --- a/lib/RON/Storage/FS.hs +++ b/lib/RON/Storage/FS.hs @@ -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) diff --git a/lib/RON/Storage/Test.hs b/lib/RON/Storage/Test.hs --- a/lib/RON/Storage/Test.hs +++ b/lib/RON/Storage/Test.hs @@ -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 ((!), (!?)) diff --git a/prelude/Prelude.hs b/prelude/Prelude.hs deleted file mode 100644 --- a/prelude/Prelude.hs +++ /dev/null @@ -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 ?: diff --git a/ron-storage.cabal b/ron-storage.cabal --- a/ron-storage.cabal +++ b/ron-storage.cabal @@ -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