diff options
Diffstat (limited to 'app')
| -rw-r--r-- | app/Store.hs | 103 |
1 files changed, 46 insertions, 57 deletions
diff --git a/app/Store.hs b/app/Store.hs index 91184a3..9e0ef00 100644 --- a/app/Store.hs +++ b/app/Store.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilyDependencies #-} @@ -16,47 +15,40 @@ module Store where -import Control.DeepSeq (NFData) -import Control.Monad.IO.Class (liftIO) -import qualified Control.Monad.State.Strict as S -import qualified Data.ByteString as BS -import qualified Data.ByteString.Short as BSS -import qualified Data.Map.Strict as M -import Data.Serialize ( - Serialize, - decode, - encode, -#if MIN_VERSION_cereal(0,5,8) -#else - get, put -#endif - ) -import GHC.Generics (Generic) -import Prelude hiding (lookup) -import System.Directory (doesFileExist) -import System.FilePath ((</>)) -import System.IO (Handle, IOMode(..), hTell, withFile) -import System.IO.MMap (mmapFileByteString) +import Control.DeepSeq ( NFData ) +import Control.Monad.IO.Class ( liftIO ) +import qualified Control.Monad.State.Strict as S +import qualified Data.ByteString as BS +import qualified Data.ByteString.Short as BSS +import qualified Data.Map.Strict as M +import Data.Serialize ( Serialize + , decode + , encode + ) +import GHC.Generics ( Generic ) +import Prelude hiding ( lookup ) +import System.Directory ( doesFileExist ) +import System.FilePath ( (</>) ) +import System.IO ( Handle + , IOMode(..) + , hTell + , withFile + ) +import System.IO.MMap ( mmapFileByteString ) data Store = Store - { index :: M.Map BSS.ShortByteString Location + { index :: M.Map BSS.ShortByteString Location , values :: BS.ByteString } data Location = Location { offset :: Int , length :: Int - } deriving (Show, Eq, Ord, Generic, NFData) + } + deriving (Show, Eq, Ord, Generic, NFData) instance Serialize Location -#if MIN_VERSION_cereal(0,5,8) -#else -instance Serialize BSS.ShortByteString where - put = put . BSS.fromShort - get = BSS.toShort <$> get -#endif - class StoreItem item where toByteString :: item -> BS.ByteString fromByteString :: BS.ByteString -> Either String item @@ -77,58 +69,55 @@ data ReadMode load :: FilePath -> ReadMode -> IO (Either String Store) load directoryPath readMode = do let valuesFilePath = directoryPath </> valuesFileName - indexFilePath = directoryPath </> indexFileName + indexFilePath = directoryPath </> indexFileName (valuesFileExists, indexFileExists) <- (,) <$> doesFileExist indexFilePath <*> doesFileExist valuesFilePath case (valuesFileExists, indexFileExists) of (True, True) -> do - indexFile <- BS.readFile indexFilePath - valuesFile <- - case readMode of - ReadEntireFile -> BS.readFile valuesFilePath - MemoryMapFile -> mmapFileByteString valuesFilePath Nothing + indexFile <- BS.readFile indexFilePath + valuesFile <- case readMode of + ReadEntireFile -> BS.readFile valuesFilePath + MemoryMapFile -> mmapFileByteString valuesFilePath Nothing let eitherIndex = decode @(M.Map BSS.ShortByteString Location) indexFile case eitherIndex of - Right locMap -> return . Right $ Store {index = locMap, values = valuesFile} + Right locMap -> + return . Right $ Store { index = locMap, values = valuesFile } Left err -> return . Left $ "Error while decoding index : " ++ err (False, False) -> return . Left $ "Cannot find index and values in " ++ directoryPath - (True, False) -> return . Left $ "Cannot find index in " ++ directoryPath - (False, True) -> return . Left $ "Cannot find values in " ++ directoryPath + (True , False) -> return . Left $ "Cannot find index in " ++ directoryPath + (False, True ) -> return . Left $ "Cannot find values in " ++ directoryPath lookup :: (StoreItem item) => KeyArgs item -> Store -> Either String item lookup keyArgs = lookupByteString (itemKey keyArgs) -lookupByteString :: - (StoreItem item) => BSS.ShortByteString -> Store -> Either String item -lookupByteString key store = - case M.lookup key (index store) of - Just (Location off len) -> - fromByteString . BS.take len . BS.drop off $ values store - Nothing -> Left $ "Cannot find item with key " ++ show key +lookupByteString + :: (StoreItem item) => BSS.ShortByteString -> Store -> Either String item +lookupByteString key store = case M.lookup key (index store) of + Just (Location off len) -> + fromByteString . BS.take len . BS.drop off $ values store + Nothing -> Left $ "Cannot find item with key " ++ show key -data State = - State (M.Map BSS.ShortByteString Location) - Handle +data State = State (M.Map BSS.ShortByteString Location) Handle add :: (StoreItem item) => item -> KeyArgs item -> S.StateT State IO () add item keyArgs = do - let bs = toByteString item + let bs = toByteString item len = BS.length bs State locMap handle <- S.get - off <- liftIO $ fromIntegral <$> hTell handle - _ <- liftIO $ BS.hPut handle bs + off <- liftIO $ fromIntegral <$> hTell handle + _ <- liftIO $ BS.hPut handle bs S.put $ State (M.insert (itemKey keyArgs) (Location off len) locMap) handle -createStore :: - FilePath -> (Handle -> IO (M.Map BSS.ShortByteString Location)) -> IO () +createStore + :: FilePath -> (Handle -> IO (M.Map BSS.ShortByteString Location)) -> IO () createStore directoryPath action = withFile (directoryPath </> valuesFileName) WriteMode $ \valuesHandle -> do locMap <- action valuesHandle BS.writeFile (directoryPath </> indexFileName) (encode locMap) -writeValues :: - Handle +writeValues + :: Handle -> M.Map BSS.ShortByteString Location -> S.StateT State IO () -> IO (M.Map BSS.ShortByteString Location) |