eternity (empty) → 0.1

raw patch · 11 files changed

+361/−0 lines, 11 filesdep +QuickCheckdep +attoparsecdep +basesetup-changed

Dependencies added: QuickCheck, attoparsec, base, cereal, directory, eternity, foldl, potoki, potoki-cereal, quickcheck-instances, rerebase, tasty, tasty-hunit, tasty-quickcheck, text

Files

• LICENSE +22/−0
• Setup.hs +2/−0
• eternity.cabal +87/−0
• library/Eternity/Attoparsec/FileNames.hs +13/−0
• library/Eternity/Foldl/FileNames.hs +20/−0
• library/Eternity/Foldl/General.hs +20/−0
• library/Eternity/IO/FileNames.hs +12/−0
• library/Eternity/Potoki/Consume.hs +28/−0
• library/Eternity/Potoki/Produce.hs +29/−0
• library/Eternity/Prelude.hs +91/−0
• test/Main.hs +37/−0

@@ -0,0 +1,22 @@+Copyright (c) 2018, Metrix.AI++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,87 @@+name:+  eternity+version:+  0.1+synopsis:+  Native event-sourcing database+description:+  Streaming-based interface for an event-sourcing store.+category:+  Database, Eventsourcing, Streaming+homepage:+  https://github.com/metrix-ai/eternity +bug-reports:+  https://github.com/metrix-ai/eternity/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Metrix.AI Ninjas <ninjas@metrix.ai>+copyright:+  (c) 2018, Metrix.AI+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10++source-repository head+  type:+    git+  location:+    git://github.com/metrix-ai/eternity.git++library+  hs-source-dirs:+    library+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  exposed-modules:+    Eternity.Potoki.Consume+    Eternity.Potoki.Produce+  other-modules:+    Eternity.Attoparsec.FileNames+    Eternity.Foldl.FileNames+    Eternity.Foldl.General+    Eternity.IO.FileNames+    Eternity.Prelude+  build-depends:+    attoparsec >=0.13 && <0.14,+    base >=4.8 && <5,+    cereal >=0.5.4 && <0.6,+    text >=1 && <2,+    directory >=1.3 && <2,+    foldl >=1.3.5 && <2,+    potoki >=0.9 && <0.10,+    potoki-cereal >=0.1 && <0.2++test-suite test+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    test+  main-is:+    Main.hs+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  build-depends:+    -- +    eternity,+    potoki,+    potoki-cereal,+    cereal,+    -- testing:+    tasty >=1 && <2,+    tasty-quickcheck >=0.10 && <0.11,+    tasty-hunit >=0.10 && <0.11,+    quickcheck-instances >=0.3.16 && <0.4,+    QuickCheck >=2.10 && <3,+    --+    directory >=1.3 && <2,+    rerebase >=1.1 && <2

@@ -0,0 +1,13 @@+module Eternity.Attoparsec.FileNames+where++import Eternity.Prelude+import Data.Attoparsec.Text+++eventsFileName :: Parser Int+eventsFileName =+  do+    index <- decimal+    string ".events"+    return index

@@ -0,0 +1,20 @@+module Eternity.Foldl.FileNames+where++import Eternity.Prelude hiding (maximum)+import Control.Foldl+import Eternity.Foldl.General+import qualified Eternity.Attoparsec.FileNames as C+++nextEventFileName :: Fold FilePath FilePath+nextEventFileName =+  fmap (maybe "1.events" (\ index -> showInt (succ index) ".events")) lastEventFileIndex++lastEventFileIndex :: Fold FilePath (Maybe Int)+lastEventFileIndex =+  onEventFileIndices maximum++onEventFileIndices :: Fold Int a -> Fold FilePath a+onEventFileIndices =+  premap fromString . parsing C.eventsFileName . ignoringLeft

@@ -0,0 +1,20 @@+module Eternity.Foldl.General+where++import Eternity.Prelude hiding (maximum)+import Control.Foldl+import qualified Data.Attoparsec.Text as B+++parsing :: B.Parser parsed -> Fold (Either Text parsed) folded -> Fold Text folded+parsing parser =+  premap (bimap fromString id . B.parseOnly parser)++ignoringLeft :: Fold right folded -> Fold (Either left right) folded+ignoringLeft (Fold rightProgress rightStart rightStop) =+  Fold progress rightStart rightStop+  where+    progress !state =+      \ case+        Right right -> rightProgress state right+        Left _ -> state

@@ -0,0 +1,12 @@+module Eternity.IO.FileNames+where++import Eternity.Prelude+import qualified System.Directory as A+import qualified Eternity.Foldl.FileNames as B+import qualified Control.Foldl as C+++determineNextEventFilePath :: FilePath -> IO (Either IOException FilePath)+determineNextEventFilePath dirPath =+  try (fmap (mappend dirPath . (:) '/' . C.fold B.nextEventFileName) (A.listDirectory dirPath))

@@ -0,0 +1,28 @@+module Eternity.Potoki.Consume+where++import Eternity.Prelude hiding (fold)+import Potoki.Consume+import qualified Eternity.IO.FileNames as D+import qualified Potoki.Cereal.Transform as E+++{-|+Write the events in a file in the specified directory, overwriting it if it already exists.++If any file IO error appears, Consume returns it wrapped in Left.+-}+writeToFile :: Serialize event => FilePath -> Consume event (Either IOException ())+writeToFile =+  transform E.encode . writeBytesToFile++{-|+Write the events to a new file in the specified directory.++If any file IO error appears, Consume returns it wrapped in Left.+-}+writeToDir :: Serialize event => FilePath -> Consume event (Either IOException ())+writeToDir path =+  liftIO (D.determineNextEventFilePath path) >>=+  traverse (transform E.encode . writeBytesToFile) >>=+  return . join

@@ -0,0 +1,29 @@+module Eternity.Potoki.Produce+where++import Eternity.Prelude+import Potoki.Produce+import qualified Potoki.Cereal.Transform as E+import qualified Potoki.Transform as A+import qualified Potoki.IO as B+import qualified Potoki.Consume as C+++{-|+Read events from a file.+-}+readFromFile :: Serialize event => FilePath -> Produce (Either IOException (Either Text event))+readFromFile path =+  transform (right E.decode) (fileBytes path)++{-|+Read events from a directory, which has been populated with 'Eternity.Potoki.Consume.writeToDir'.+-}+readFromDir :: Serialize event => FilePath -> Produce (Either IOException (Either Text event))+readFromDir dirPath =+  transform+    (right (A.produce readFromFile) >>^ either Left id)+    (directoryContents dirPath)+  where+    readFromFileTransform =+      A.produce readFromFile

@@ -0,0 +1,91 @@+module Eternity.Prelude+(+  module Exports,+  textString,+)+where++-- base+-------------------------+import Control.Applicative as Exports+import Control.Arrow as Exports hiding (first, second)+import Control.Category as Exports+import Control.Concurrent as Exports+import Control.Exception as Exports+import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Monad.IO.Class as Exports+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.ST as Exports+import Data.Bifunctor as Exports+import Data.Bits as Exports+import Data.Bool as Exports+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Complex as Exports+import Data.Data as Exports+import Data.Dynamic as Exports+import Data.Either as Exports+import Data.Fixed as Exports+import Data.Foldable as Exports+import Data.Function as Exports hiding (id, (.))+import Data.Functor as Exports+import Data.Int as Exports+import Data.IORef as Exports+import Data.Ix as Exports+import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')+import Data.Maybe as Exports+import Data.Monoid as Exports+import Data.Ord as Exports+import Data.Proxy as Exports+import Data.Ratio as Exports+import Data.STRef as Exports+import Data.String as Exports+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.Unique as Exports+import Data.Version as Exports+import Data.Word as Exports+import Debug.Trace as Exports+import Foreign.ForeignPtr as Exports+import Foreign.Ptr as Exports+import Foreign.StablePtr as Exports+import Foreign.Storable as Exports+import GHC.Conc as Exports hiding (withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)+import GHC.Exts as Exports (lazy, inline, sortWith, groupWith)+import GHC.Generics as Exports (Generic)+import GHC.IO.Exception as Exports+import Numeric as Exports+import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.))+import System.Environment as Exports+import System.Exit as Exports+import System.IO as Exports+import System.IO.Error as Exports+import System.IO.Unsafe as Exports+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)+import Text.Printf as Exports (printf, hPrintf)+import Text.Read as Exports (Read(..), readMaybe, readEither)+import Unsafe.Coerce as Exports++-- foldl+-------------------------+import Control.Foldl as Exports (Fold(..), FoldM(..))++-- cereal+-------------------------+import Data.Serialize as Exports (Serialize)++-- text+-------------------------+import Data.Text as Exports (Text)++-- Custom+-------------------------+import qualified Data.Text as A++textString :: Text -> String+textString =+  A.unpack

@@ -0,0 +1,37 @@+module Main where++import Prelude+import Test.QuickCheck.Instances+import Test.Tasty+import Test.Tasty.Runners+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import System.Directory+import qualified Eternity.Potoki.Produce as O+import qualified Eternity.Potoki.Consume as P+import qualified Potoki.Produce as F+import qualified Potoki.IO as G+import qualified Potoki.Consume as H+++main =+  defaultMain $+  testGroup "Store and read events" $+  [+    testProperty "Store and read events" $ \ (events :: [Int]) ->+    unsafePerformIO $ do+      removePathForcibly directory+      createDirectoryIfMissing True directory+      writeEvents events+      readEventsResult <- readEvents+      return (Right (Right events) === readEventsResult)+  ]+  where+    directory =+      "dist/test-events"+    writeEvents events =+      G.produceAndConsume (F.list events) (P.writeToDir directory)+    readEvents =+      G.produceAndConsume+        (O.readFromDir directory)+        (right' (right' H.list))