diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/lib/RON/Storage.hs b/lib/RON/Storage.hs new file mode 100644 --- /dev/null +++ b/lib/RON/Storage.hs @@ -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 diff --git a/lib/RON/Storage/IO.hs b/lib/RON/Storage/IO.hs new file mode 100644 --- /dev/null +++ b/lib/RON/Storage/IO.hs @@ -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 diff --git a/lib/RON/Storage/Test.hs b/lib/RON/Storage/Test.hs new file mode 100644 --- /dev/null +++ b/lib/RON/Storage/Test.hs @@ -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) diff --git a/prelude/Prelude.hs b/prelude/Prelude.hs new file mode 100644 --- /dev/null +++ b/prelude/Prelude.hs @@ -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 ?: diff --git a/ron-storage.cabal b/ron-storage.cabal new file mode 100644 --- /dev/null +++ b/ron-storage.cabal @@ -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 +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