raft 0.3.7.2 → 0.3.11.0
raw patch · 8 files changed
+378/−7 lines, 8 filesdep +cerealdep +stm
Dependencies added: cereal, stm
Files
- raft.cabal +10/−3
- src/Control/Concurrent/Util.hs +40/−0
- src/Control/Monad/Except/Util.hs +26/−3
- src/Control/Monad/Util.hs +34/−0
- src/Data/Journal.hs +68/−0
- src/Data/Journal/Empty.hs +35/−0
- src/Data/Journal/File.hs +164/−0
- src/Data/Maybe/Util.hs +1/−1
raft.cabal view
@@ -1,5 +1,5 @@ name : raft-version : 0.3.7.2+version : 0.3.11.0 synopsis : Miscellaneous Haskell utilities for data structures and data manipulation. description : This Haskell library contains miscellaneous data structures and data manipulation functions for general uses. @@ -7,7 +7,7 @@ license-file : LICENSE author : Brian W Bush <consult@brianwbush.info> maintainer : Brian W Bush <consult@brianwbush.info>-copyright : (c) 2005-16 Brian W Bush+copyright : (c) 2005-17 Brian W Bush category : Data stability : Experimental build-type : Simple@@ -26,6 +26,7 @@ library exposed-modules : Control.Monad.Except.Util+ Control.Monad.Util Data.Color.Util Data.Default.Util Data.EdgeTree@@ -35,6 +36,8 @@ Data.Function.MapReduce Data.Function.MapReduce.Internal Data.Function.Util+ Data.Journal+ Data.Journal.Empty Data.List.Util Data.List.Util.Listable Data.Maybe.Util@@ -47,10 +50,12 @@ Math.Roots.Bisection Math.Series if !flag(minimal)- exposed-modules: Data.Aeson.Util+ exposed-modules: Control.Concurrent.Util+ Data.Aeson.Util Data.Attoparsec.Util Data.Function.MapReduce.Parallel Data.Function.Tabulated+ Data.Journal.File Data.Relational Data.Relational.Lists Data.Relational.Value@@ -73,8 +78,10 @@ if !flag(minimal) build-depends : aeson >= 0.11.2 , attoparsec >= 0.13.0+ , cereal , parallel >= 3.2.0 , scientific >= 0.3.3+ , stm , zlib >= 0.5.4 exposed : True buildable : True
+ src/Control/Concurrent/Util.hs view
@@ -0,0 +1,40 @@+-----------------------------------------------------------------------------+--+-- Module : Control.Concurrent.Util+-- Copyright : (c) 2016-17 Brian W Bush+-- License : MIT+--+-- Maintainer : Brian W Bush <consult@brianwbush.info>+-- Stability : Stable+-- Portability : Portable+--+-- | Utilities related to concurrency.+--+-----------------------------------------------------------------------------+++module Control.Concurrent.Util (+-- * Miscellaneous+ makeCounter+) where+++import Control.Concurrent.STM (atomically)+import Control.Concurrent.STM.TVar (newTVarIO, readTVar, writeTVar)+++-- | Make a counter.+makeCounter :: (a -> a) -- ^ How to increment the counter.+ -> a -- ^ The initial value of the counter.+ -> IO (IO a) -- ^ Action for creating the action to increment the counter.+makeCounter f i =+ do+ counter <- newTVarIO i+ let+ next =+ atomically+ $ do+ j <- f <$> readTVar counter+ writeTVar counter j+ return j+ return next
src/Control/Monad/Except/Util.hs view
@@ -13,7 +13,8 @@ ----------------------------------------------------------------------------- -{-# LANGUAGE Safe #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Safe #-} module Control.Monad.Except.Util (@@ -22,18 +23,40 @@ , deny -- * Input/Output , tryIO+, guardIO+, eitherError+, runToIO ) where -import Control.Exception (IOException, try)+import Control.Exception (IOException, throw, try) import Control.Monad (unless, when)-import Control.Monad.Except (MonadError, MonadIO, liftIO, throwError)+import Control.Monad.Except (ExceptT, MonadError, MonadIO, liftIO, runExceptT, throwError) import Data.String (IsString(..))+import System.IO.Error (tryIOError) -- | Attempt an IO action. tryIO :: (IsString e, MonadError e m, MonadIO m) => IO a -> m a tryIO = (>>= either (\e -> throwError . fromString $ show (e :: IOException)) return) . liftIO . try+++-- | Catch 'Control.Exception.IOException' and throw it into 'MonadError String'. Derived from <http://chromaticleaves.com/posts/guard-io-with-errort.html>.+guardIO :: (MonadIO m, MonadError String m) => IO a -> m a+guardIO =+ (either (throwError . show) return =<<)+ . liftIO+ . tryIOError+++-- | Throw 'Data.Either.Left' into 'Control.Exception.IOException'.+eitherError :: (a -> b) -> Either String a -> IO b+eitherError f = either (throw . userError) (return . f)+++-- | Run 'Control.Monad.Except.ExceptT' to 'System.IO'.+runToIO :: ExceptT String IO a -> IO a+runToIO = (eitherError id =<<) . runExceptT -- | Make an assertion.
+ src/Control/Monad/Util.hs view
@@ -0,0 +1,34 @@+-----------------------------------------------------------------------------+--+-- Module : Control.Monad.Util+-- Copyright : (c) 2017 Brian W Bush+-- License : MIT+--+-- Maintainer : Brian W Bush <consult@brianwbush.info>+-- Stability : Stable+-- Portability : Portable+--+-- | Utilities for monads.+--+-----------------------------------------------------------------------------+++module Control.Monad.Util (+-- * Iteration+ collectWhile+) where+++-- | Collect the results of running an action repeatedly while a condition holds.+collectWhile :: Monad m+ => m a -- ^ The action to repeat.+ -> m Bool -- ^ The action for the condition that must hold.+ -> m [a] -- ^ An action collecting the results.+collectWhile next test =+ do+ t <- test+ if t+ then do+ n <- next+ (n :) <$> collectWhile next test+ else return []
+ src/Data/Journal.hs view
@@ -0,0 +1,68 @@+-----------------------------------------------------------------------------+--+-- Module : Data.Journal+-- Copyright : (c) 2017 Brian W Bush+-- License : MIT+--+-- Maintainer : Brian W Bush <consult@brianwbush.info>+-- Stability : Stable+-- Portability : Portable+--+-- | Simple logging to a journal.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE FlexibleContexts #-}+++module Data.Journal (+-- * Types+ Key+, Entry+, Journal(..)+) where+++import Control.Monad.Except (MonadError, MonadIO)+import Data.ByteString.Char8 (ByteString)+++-- | Journal entries are keyed by byte strings.+type Key = ByteString+++-- | Journal entries are byte strings.+type Entry = ByteString+++-- | Type class for logging to a journal.+class Journal a where++ -- | Append a log entry.+ append :: (MonadIO m, MonadError String m)+ => a -- ^ The journal.+ -> (Key, Entry) -- ^ The key and value to be logged.+ -> m () -- ^ An action to peform the logging.++ -- | Erase a log entry.+ erase :: (MonadIO m, MonadError String m)+ => a -- ^ The journal.+ -> Key -- ^ The key for the entry to be erased.+ -> m () -- ^ An action to erase the log entry.++ -- | Replay the journal to extract all log entries.+ replay :: (MonadIO m, MonadError String m)+ => Bool -- ^ Whether to compress the journal, erasing obsolete entries.+ -> a -- ^ The journal.+ -> m [(Key, Entry)] -- ^ An action listing all log entries.++ -- | Erase all log entries from the journal.+ clear :: (MonadIO m, MonadError String m)+ => a -- ^ The journal.+ -> m () -- ^ An action to erase all log entries.++ -- | Close a journal.+ close :: (MonadIO m, MonadError String m)+ => a -- ^ The journal.+ -> m () -- ^ An action to close the journal.
+ src/Data/Journal/Empty.hs view
@@ -0,0 +1,35 @@+-----------------------------------------------------------------------------+--+-- Module : Data.Journal.Empty+-- Copyright : (c) 2017 Brian W Bush+-- License : MIT+--+-- Maintainer : Brian W Bush <consult@brianwbush.info>+-- Stability : Stable+-- Portability : Portable+--+-- | A journal that does no logging.+--+-----------------------------------------------------------------------------+++module Data.Journal.Empty (+ -- * Types+ EmptyJournal(..)+) where+++import Data.Journal (Journal(..))+++-- | A journal that does no logging.+data EmptyJournal =+ EmptyJournal+ deriving (Eq, Read, Show)++instance Journal EmptyJournal where+ append = const . const $ return ()+ erase = const . const $ return ()+ replay = const . const $ return []+ clear = const $ return ()+ close = const $ return ()
+ src/Data/Journal/File.hs view
@@ -0,0 +1,164 @@+-----------------------------------------------------------------------------+--+-- Module : Data.Journal.File+-- Copyright : (c) 2017 Brian W Bush+-- License : MIT+--+-- Maintainer : Brian W Bush <consult@brianwbush.info>+-- Stability : Stable+-- Portability : Portable+--+-- | A file-backed journal that does no logging.+--+-----------------------------------------------------------------------------+++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+++module Data.Journal.File (+ -- * Types+ FileJournal+ -- * Construction+, openJournal+, openJournalIO+) where+++import Control.Arrow (second)+import Control.Monad (when, void)+import Control.Monad.Except (MonadError, MonadIO, runExceptT)+import Control.Monad.Except.Util (guardIO, eitherError)+import Control.Monad.Util (collectWhile)+import Data.ByteString.Char8 as BS (head, hGet, hPut, length, singleton)+import Data.Journal (Entry, Journal(..), Key)+import Data.Map.Lazy as M (filter, fromList, map, toList)+import Data.Maybe (fromJust, isJust)+import Data.Serialize (decode, encode)+import Data.Word (Word32)+import System.IO (BufferMode(..), Handle, IOMode(..), SeekMode(..), hClose, hFlush, hGetPosn, hIsEOF, hSeek, hSetBuffering, hSetFileSize, hSetPosn, openFile)+++-- | A file-backed journal.+data FileJournal =+ FileJournal+ {+ file :: FilePath -- ^ The file name.+ , handle :: Handle -- ^ The handle to the file.+ }+ deriving (Eq, Show)++instance Journal FileJournal where++ append FileJournal{..} = guardIO . save handle . second Just+ + erase FileJournal{..} = guardIO . save handle . (, Nothing)+ + replay compact FileJournal{..} =+ guardIO+ $ do+ hSeek handle AbsoluteSeek 0+ keyEntries <-+ M.toList+ . M.map fromJust+ . M.filter isJust+ . M.fromList+ <$> collectWhile (load handle) (hasNext handle)+ when compact+ $ do -- FIXME: Make this atomic.+ hSeek handle AbsoluteSeek 0+ hSetFileSize handle 0+ mapM_ (save handle . second Just) keyEntries+ return keyEntries++ clear FileJournal{..} =+ guardIO+ $ do+ hSeek handle AbsoluteSeek 0+ hSetFileSize handle 0++ close FileJournal{..} = guardIO $ hClose handle+++-- | Determine whether there is a valid next entry in the journal.+hasNext :: Handle -- ^ The file handle for the journal.+ -> IO Bool -- ^ An action to determine whether there is a valid next entry.+hasNext h =+ do+ e <- hIsEOF h+ if e+ then return False+ else do+ i <- hGetPosn h+ flag <- hGetEnum h+ hSetPosn i+ return flag+++-- | Get a one-byte enum.+hGetEnum :: Enum a+ => Handle -- ^ The file handle.+ -> IO a -- ^ An action to read the enum.+hGetEnum h = toEnum . fromEnum . BS.head <$> BS.hGet h 1+++-- | Put a one-byte enum.+hPutEnum :: Enum a+ => Handle -- ^ The file handle.+ -> a -- ^ The enum.+ -> IO () -- ^ An action to write the enum.+hPutEnum h = BS.hPut h . BS.singleton . toEnum . fromEnum+++-- | Write an entry to a journal.+save :: Handle -- ^ The file handle for the journal.+ -> (Key, Maybe Entry) -- ^ The entry, or whose lack of an entry indicates deletion.+ -> IO () -- ^ An action to write the entry.+save h (key, entry) =+ do+ i <- hGetPosn h+ hPutEnum h False+ let+ payload = encode (key, entry)+ n = (toEnum :: Int -> Word32) $ BS.length payload+ n' = encode n+ BS.hPut h n'+ BS.hPut h payload+ j <- hGetPosn h+ hSetPosn i+ hPutEnum h True+ hSetPosn j+ hFlush h+++-- | Read an entry from a journal.+load :: Handle -- ^ The file handle for the journal.+ -> IO (Key, Maybe Entry) -- ^ An action to read the entry, or whose lack of an entry indicates deletion.+load h =+ do+ void $ BS.hGet h 1+ n' <- BS.hGet h 4+ n <- eitherError (fromEnum :: Word32 -> Int) $ decode n'+ payload <- BS.hGet h n+ eitherError id $ decode payload+ ++-- | Open a journal. +openJournal :: (MonadIO m, MonadError String m)+ => FilePath -- ^ The location of the journal file.+ -> m FileJournal -- ^ An action to open the journal.+openJournal file =+ guardIO+ $ do+ handle <- openFile file ReadWriteMode+ hSetBuffering handle $ BlockBuffering Nothing+ hSeek handle SeekFromEnd 0+ return FileJournal{..}+++-- | Open a journal.+openJournalIO :: FilePath -- ^ The location of the journal file.+ -> IO FileJournal -- ^ An IO action to open the journal.+openJournalIO = (eitherError id =<<) . runExceptT . openJournal
src/Data/Maybe/Util.hs view
@@ -8,7 +8,7 @@ -- Stability : Stable -- Portability : Portable ----- | Utility functions for 'Data.Maybe.Maybe'.+-- | Utility functions for 'Data.Maybe'. -- -----------------------------------------------------------------------------