ron-storage (empty) → 0.5
raw patch · 6 files changed
+743/−0 lines, 6 filesdep +basedep +bytestringdep +containers
Dependencies added: base, bytestring, containers, directory, filepath, integer-gmp, mtl, network-info, ron, ron-rdt, text, transformers
Files
- LICENSE +29/−0
- lib/RON/Storage.hs +207/−0
- lib/RON/Storage/IO.hs +185/−0
- lib/RON/Storage/Test.hs +88/−0
- prelude/Prelude.hs +164/−0
- ron-storage.cabal +70/−0
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2018, Yuriy Syrovetskiy+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 the copyright holder nor the names of its+ 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 HOLDER 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.
+ lib/RON/Storage.hs view
@@ -0,0 +1,207 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}++-- | RON File Storage. For usage, see "RON.Storage.IO".+module RON.Storage (+ Collection (..),+ CollectionName,+ DocId (..),+ Document (..),+ DocVersion,+ MonadStorage (..),+ createDocument,+ decodeDocId,+ docIdFromUuid,+ loadDocument,+ modify,+ readVersion,+) where++import qualified Data.ByteString.Lazy.Char8 as BSLC+import Data.String (fromString)+import qualified Data.Text as Text+import qualified Text.Show++import RON.Data (ReplicatedAsObject, reduceObject)+import RON.Error (Error (Error), MonadE, errorContext, liftMaybe,+ throwErrorString)+import RON.Event (ReplicaClock, getEventUuid)+import RON.Text (parseStateFrame, serializeStateFrame)+import RON.Types (Object (Object, frame, id), UUID)+import RON.Util (ByteStringL)+import qualified RON.UUID as UUID++-- | Document version identifier (file name)+type DocVersion = FilePath++-- | Document identifier (directory name),+-- should be a RON-Base32-encoded RON-UUID.+newtype DocId a = DocId FilePath+ deriving (Eq, Ord)++instance Collection a => Show (DocId a) where+ show (DocId file) = collectionName @a </> file++-- | Collection (directory name)+type CollectionName = FilePath++-- | A type that intended to be put in a separate collection must define a+-- Collection instance.+class (ReplicatedAsObject a, Typeable a) => Collection a where++ collectionName :: CollectionName++ -- | Called when RON parser fails.+ fallbackParse :: MonadE m => UUID -> ByteStringL -> m (Object a)+ fallbackParse _ _ = throwError "no fallback parser implemented"++-- | Storage backend interface+class (ReplicaClock m, MonadE m) => MonadStorage m where+ getCollections :: m [CollectionName]++ -- | Must return @[]@ for non-existent collection+ getDocuments :: Collection a => m [DocId a]++ -- | Must return @[]@ for non-existent document+ getDocumentVersions :: Collection a => DocId a -> m [DocVersion]++ -- | Must create collection and document if not exist+ saveVersionContent+ :: Collection a => DocId a -> DocVersion -> ByteStringL -> m ()++ loadVersionContent :: Collection a => DocId a -> DocVersion -> m ByteStringL++ deleteVersion :: Collection a => DocId a -> DocVersion -> m ()++ changeDocId :: Collection a => DocId a -> DocId a -> m ()++-- | Try decode UUID from a file name+decodeDocId+ :: DocId a+ -> Maybe (Bool, UUID) -- ^ Bool = is document id a valid UUID encoding+decodeDocId (DocId file) = do+ uuid <- UUID.decodeBase32 file+ pure (UUID.encodeBase32 uuid == file, uuid)++-- | Load document version as an object+readVersion+ :: MonadStorage m+ => Collection a => DocId a -> DocVersion -> m (Object a, IsTouched)+readVersion docid version = do+ (isObjectIdValid, id) <-+ liftMaybe ("Bad Base32 UUID " <> show docid) $+ decodeDocId docid+ unless isObjectIdValid $+ throwErrorString $ "Not a Base32 UUID " ++ show docid+ contents <- loadVersionContent docid version+ case parseStateFrame contents of+ Right frame ->+ pure (Object{id, frame}, IsTouched False)+ Left ronError ->+ do object <- fallbackParse id contents+ pure (object, IsTouched True)+ `catchError` \fallbackError ->+ throwError $ case BSLC.head contents of+ '{' -> fallbackError+ _ -> fromString ronError++-- | A thing (e.g. document) was fixed during loading.+-- It it was fixed during loading it must be saved to the storage.+newtype IsTouched = IsTouched Bool+ deriving Show++-- | Result of DB reading, loaded document with information about its versions+data Document a = Document+ { value :: Object a+ -- ^ Merged value.+ , versions :: NonEmpty DocVersion+ , isTouched :: IsTouched+ }+ deriving Show++-- | Load all versions of a document+loadDocument :: (Collection a, MonadStorage m) => DocId a -> m (Document a)+loadDocument docid = loadRetry (3 :: Int)+ where+ loadRetry n+ | n > 0 = do+ versions0 <- getDocumentVersions docid+ case versions0 of+ [] ->+ throwErrorString $+ "Document with id " ++ show docid ++ " has not found."+ v:vs -> do+ let versions = v :| vs+ let wrapDoc (value, isTouched) =+ Document{value, versions, isTouched}+ readResults <-+ errorContext ("document " <> show docid) $+ for versions $ \ver ->+ try $+ errorContext ("version " <> Text.pack ver) $+ readVersion docid ver+ liftEither $ wrapDoc <$> vsconcat readResults+ | otherwise = throwError "Maximum retries exceeded"++-- | Validation-like version of 'sconcat'.+vsconcat+ :: NonEmpty (Either Error (Object a, IsTouched))+ -> Either Error (Object a, IsTouched)+vsconcat = foldr1 vappend+ where+ vappend (Left e1) (Left e2) = Left $ Error "vappend" [e1, e2]+ vappend e1@(Left _ ) (Right _ ) = e1+ vappend (Right _ ) e2@(Left _ ) = e2+ vappend (Right r1) (Right r2) =+ (, IsTouched (t1 || t2)) <$> reduceObject a1 a2 where+ (a1, IsTouched t1) = r1+ (a2, IsTouched t2) = r2++try :: MonadError e m => m a -> m (Either e a)+try ma = (Right <$> ma) `catchError` (pure . Left)++-- | Load document, apply changes and put it back to storage+modify+ :: (Collection a, MonadStorage m)+ => DocId a -> StateT (Object a) m () -> m (Object a)+modify docid f = do+ oldDoc <- loadDocument docid+ newObj <- execStateT f $ value oldDoc+ createVersion (Just (docid, oldDoc)) newObj+ pure newObj++-- | Create new version of an object/document.+-- If the document doesn't exist yet, it will be created.+createVersion+ :: forall a m+ . (Collection a, MonadStorage m)+ => Maybe (DocId a, Document a)+ -- ^ 'Just', if document exists already; 'Nothing' otherwise.+ -> Object a+ -> m ()+createVersion mDoc newObj = case mDoc of+ Nothing -> save (DocId @a $ UUID.encodeBase32 id) []+ Just (docid, oldDoc) -> do+ let Document{value = oldObj, versions, isTouched = IsTouched isTouched}+ = oldDoc+ when (newObj /= oldObj || length versions /= 1 || isTouched) $+ save docid versions+ where+ Object{id, frame} = newObj++ save docid oldVersions = do+ newVersion <- UUID.encodeBase32 <$> getEventUuid+ saveVersionContent docid newVersion (serializeStateFrame frame)+ for_ oldVersions $ deleteVersion docid++-- | Create document assuming it doesn't exist yet.+createDocument :: (Collection a, MonadStorage m) => Object a -> m ()+createDocument = createVersion Nothing++docIdFromUuid :: UUID -> DocId a+docIdFromUuid = DocId . UUID.encodeBase32
+ lib/RON/Storage/IO.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- | A real-world file storage.+--+-- Typical usage:+--+-- @+-- import RON.Storage.IO as Storage+--+-- main = do+-- let dataDir = ".\/data\/"+-- h <- Storage.'newHandle' dataDir+-- 'runStorage' h $ do+-- obj <- 'newObject' Note{active = True, text = "Write an example"}+-- 'createDocument' obj+-- @+module RON.Storage.IO (+ module X,+ -- * Handle+ Handle,+ OnDocumentChanged (..),+ newHandle,+ setOnDocumentChanged,+ -- * Storage+ Storage,+ runStorage,+) where++import Data.Bits (shiftL)+import qualified Data.ByteString.Lazy as BSL+import Network.Info (MAC (MAC), getNetworkInterfaces, mac)+import System.Directory (canonicalizePath, createDirectoryIfMissing,+ doesDirectoryExist, doesPathExist,+ listDirectory, removeFile, renameDirectory)+import System.IO.Error (isDoesNotExistError)++import RON.Epoch (EpochClock, getCurrentEpochTime, runEpochClock)+import RON.Error (Error, throwErrorString)+import RON.Event (EpochTime, ReplicaClock, ReplicaId, advance,+ applicationSpecific, getEvents, getPid)++import RON.Storage as X++-- | Environment is the dataDir+newtype Storage a = Storage (ExceptT Error (ReaderT Handle EpochClock) a)+ deriving (Applicative, Functor, Monad, MonadError Error, MonadIO)++-- | Run a 'Storage' action+runStorage :: Handle -> Storage a -> IO a+runStorage h@Handle{hReplica, hClock} (Storage action) = do+ res <-+ runEpochClock hReplica hClock $+ (`runReaderT` h) $+ runExceptT action+ either throwIO pure res++instance ReplicaClock Storage where+ getPid = Storage . lift $ lift getPid+ getEvents = Storage . lift . lift . getEvents+ advance = Storage . lift . lift . advance++instance MonadStorage Storage where+ getCollections = Storage $ do+ Handle{hDataDir} <- ask+ liftIO $+ listDirectory hDataDir+ >>= filterM (doesDirectoryExist . (hDataDir </>))++ getDocuments :: forall doc. Collection doc => Storage [DocId doc]+ getDocuments = map DocId <$> listDirectoryIfExists (collectionName @doc)++ getDocumentVersions = listDirectoryIfExists . docDir++ saveVersionContent docid version content = do+ Storage $ do+ Handle{hDataDir} <- ask+ let docdir = hDataDir </> docDir docid+ liftIO $ do+ createDirectoryIfMissing True docdir+ BSL.writeFile (docdir </> version) content+ emitDocumentChanged docid++ loadVersionContent docid version = Storage $ do+ Handle{hDataDir} <- ask+ liftIO $ BSL.readFile $ hDataDir </> docDir docid </> version++ deleteVersion docid version = Storage $ do+ Handle{hDataDir} <- ask+ liftIO $ do+ let file = hDataDir </> docDir docid </> version+ removeFile file+ `catch` \e ->+ unless (isDoesNotExistError e) $ throwIO e++ changeDocId old new = do+ renamed <- Storage $ do+ Handle{hDataDir} <- ask+ let oldPath = hDataDir </> docDir old+ newPath = hDataDir </> docDir new+ oldPathCanon <- liftIO $ canonicalizePath oldPath+ newPathCanon <- liftIO $ canonicalizePath newPath+ let pathsDiffer = newPathCanon /= oldPathCanon+ when pathsDiffer $ do+ newPathExists <- liftIO $ doesPathExist newPath+ when newPathExists $+ throwErrorString $ unwords+ [ "changeDocId"+ , show old, "[", oldPath, "->", oldPathCanon, "]"+ , show new, "[", newPath, "->", newPathCanon, "]"+ , ": internal error: new document id is already taken"+ ]+ liftIO $ renameDirectory oldPath newPath+ pure pathsDiffer+ when renamed $ emitDocumentChanged new++-- | Storage handle (uses the “Handle pattern”).+data Handle = Handle+ { hClock :: IORef EpochTime+ , hDataDir :: FilePath+ , hReplica :: ReplicaId+ , hOnDocumentChanged :: IORef (Maybe OnDocumentChanged)+ }++-- | 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++-- | Create new storage handle+newHandle :: FilePath -> IO Handle+newHandle hDataDir = do+ time <- getCurrentEpochTime+ hClock <- newIORef time+ hReplica <- applicationSpecific <$> getMacAddress+ hOnDocumentChanged <- newIORef Nothing+ 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+ let dir = hDataDir </> relpath+ liftIO $ do+ exists <- doesDirectoryExist dir+ if exists then listDirectory dir else pure []++docDir :: forall a . Collection a => DocId a -> FilePath+docDir (DocId dir) = collectionName @a </> dir++-- MAC address++getMacAddress :: IO Word64+getMacAddress = decodeMac <$> getMac where+ getMac+ = fromMaybe+ (error "Can't get any non-zero MAC address of this machine")+ . listToMaybe+ . filter (/= minBound)+ . map mac+ <$> getNetworkInterfaces+ decodeMac (MAC b5 b4 b3 b2 b1 b0)+ = fromIntegral b5 `shiftL` 40+ + fromIntegral b4 `shiftL` 32+ + fromIntegral b3 `shiftL` 24+ + fromIntegral b2 `shiftL` 16+ + fromIntegral b1 `shiftL` 8+ + fromIntegral b0
+ lib/RON/Storage/Test.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module RON.Storage.Test (TestDB, runStorageSim) where++import qualified Data.ByteString.Lazy.Char8 as BSLC+import Data.Functor.Compose (Compose (Compose), getCompose)+import Data.Map.Strict ((!), (!?))+import qualified Data.Map.Strict as Map++import RON.Error (Error)+import RON.Event (ReplicaClock, applicationSpecific)+import RON.Event.Simulation (ReplicaSim, runNetworkSim, runReplicaSim)+import RON.Util (ByteStringL)++import RON.Storage (Collection, CollectionName, DocId (DocId),+ DocVersion, MonadStorage, changeDocId,+ collectionName, deleteVersion, getCollections,+ getDocumentVersions, getDocuments,+ loadVersionContent, saveVersionContent)++type TestDB = Map CollectionName (Map DocumentId (Map DocVersion Document))++type Document = [ByteStringL]++type DocumentId = FilePath++-- * Storage simulation++newtype StorageSim a = StorageSim (StateT TestDB (ExceptT Error ReplicaSim) a)+ deriving (Applicative, Functor, Monad, MonadError Error, ReplicaClock)++runStorageSim :: TestDB -> StorageSim a -> Either Error (a, TestDB)+runStorageSim db (StorageSim action) =+ runNetworkSim $ runReplicaSim (applicationSpecific 34) $+ runExceptT $ runStateT action db++instance MonadStorage StorageSim where+ getCollections = StorageSim $ gets Map.keys++ getDocuments :: forall a . Collection a => StorageSim [DocId a]+ getDocuments = StorageSim $ do+ db <- get+ pure $ map DocId $ Map.keys $ db !. collectionName @a++ getDocumentVersions (DocId doc :: DocId a) = StorageSim $ do+ db <- get+ pure $ Map.keys $ db !. collectionName @a !. doc++ saveVersionContent (DocId docid :: DocId a) version content = do+ let document = BSLC.lines content+ let insertDocumentVersion =+ Just . Map.insertWith (<>) version document . fromMaybe mempty+ let alterDocument+ = Just+ . Map.alter insertDocumentVersion docid+ . fromMaybe mempty+ let alterCollection = Map.alter alterDocument (collectionName @a)+ StorageSim $ modify' alterCollection++ loadVersionContent (DocId dir :: DocId a) version = StorageSim $ do+ db <- get+ pure $ BSLC.unlines $ db !. collectionName @a !. dir ! version++ deleteVersion (DocId doc :: DocId a) version+ = StorageSim+ . modify'+ . (`Map.adjust` collectionName @a)+ . (`Map.adjust` doc)+ $ Map.delete version++ changeDocId (DocId old :: DocId a) (DocId new :: DocId a) = StorageSim $+ modify' $ (`Map.adjust` collectionName @a) $ \collection ->+ maybe collection (uncurry $ Map.insert new) $+ mapTake old collection++(!.) :: Ord a => Map a (Map b c) -> a -> Map b c+m !. a = fromMaybe Map.empty $ m !? a++mapTake :: Ord k => k -> Map k a -> Maybe (a, Map k a)+mapTake k = getCompose . Map.alterF (Compose . f) k where+ f = \case+ Nothing -> Nothing+ Just a -> Just (a, Nothing)
+ prelude/Prelude.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}++module Prelude (+ module X,+ fmapL,+ foldr1,+ identity,+ lastDef,+ maximumDef,+ maxOn,+ minOn,+ 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 (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++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++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++-- | An infix form of 'fromMaybe' with arguments flipped.+(?:) :: Maybe a -> a -> a+maybeA ?: b = fromMaybe b maybeA+{-# INLINABLE (?:) #-}+infixr 0 ?:
+ ron-storage.cabal view
@@ -0,0 +1,70 @@+cabal-version: 2.2++name: ron-storage+version: 0.5++bug-reports: https://github.com/ff-notes/ron/issues+category: Distributed Systems, Protocol, Database+copyright: 2018-2019 Yuriy Syrovetskiy+homepage: https://github.com/ff-notes/ron+license: BSD-3-Clause+license-file: LICENSE+maintainer: Yuriy Syrovetskiy <haskell@cblp.su>+synopsis: RON Storage++description:+ Replicated Object Notation (RON), data types (RDT), and RON-Schema+ .+ Typical usage:+ .+ > import RON.Data+ > import RON.Schema.TH+ > import RON.Storage.IO 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++build-type: Simple++common language+ build-depends: base >= 4.10 && < 4.13, integer-gmp+ default-extensions: MonadFailDesugaring StrictData+ default-language: Haskell2010+ hs-source-dirs: prelude+ other-modules: Prelude++library+ import: language+ build-depends:+ -- global+ bytestring,+ containers,+ directory,+ filepath,+ mtl,+ network-info,+ text,+ transformers,+ -- project+ ron,+ ron-rdt+ exposed-modules:+ RON.Storage+ RON.Storage.IO+ RON.Storage.Test+ hs-source-dirs: lib