mirror of https://github.com/voidlizard/hbs2
FuckOS X storage patch
This commit is contained in:
parent
9a90884d46
commit
67081eac22
|
@ -1,3 +1,4 @@
|
|||
{-# Language CPP #-}
|
||||
{-# Language MultiWayIf #-}
|
||||
{-# Language AllowAmbiguousTypes #-}
|
||||
{-# Language UndecidableInstances #-}
|
||||
|
@ -36,6 +37,7 @@ import Data.IntMap qualified as IntMap
|
|||
import Data.IntMap (IntMap)
|
||||
import Data.Fixed
|
||||
import System.Environment
|
||||
import System.Posix
|
||||
import System.Posix.Fcntl
|
||||
import System.Posix.IO
|
||||
import System.Posix.Files (setFileSize)
|
||||
|
@ -207,6 +209,18 @@ nwayAllocPow2 NWayHashAlloc{..} num = fromIntegral $
|
|||
nwayAllocResizeDefault :: NWayHashAlloc -> Int -> Int -> Int -> Maybe Int
|
||||
nwayAllocResizeDefault NWayHashAlloc{..} i c num = Nothing
|
||||
|
||||
|
||||
nwayFileAllocate :: Fd -> COff -> COff -> IO ()
|
||||
#ifdef darwin_HOST_OS
|
||||
nwayFileAllocate fd offset size = do
|
||||
let chunk = BS.replicate (fromIntegral size) 0
|
||||
_ <- fdSeek fd AbsoluteSeek (fromIntegral offset)
|
||||
void $ fdWrite fd chunk
|
||||
#else
|
||||
nwayFileAllocate = fileAllocate
|
||||
#endif
|
||||
|
||||
|
||||
nwayWriteBatch :: MonadUnliftIO m
|
||||
=> NWayHashAlloc
|
||||
-> FilePath -- ^ dir
|
||||
|
@ -272,7 +286,7 @@ nwayWriteBatch nwa@NWayHashAlloc{..} path tpl items' = do
|
|||
let pageSize = buckNum * buckSize
|
||||
|
||||
liftIO do
|
||||
fileAllocate fd pageOff (fromIntegral pageSize)
|
||||
nwayFileAllocate fd pageOff (fromIntegral pageSize)
|
||||
|
||||
for_ es $ \(k,v) -> do
|
||||
let ki = BS.take kpiece (BS.drop (i*kpiece) k ) & N.word64
|
||||
|
|
|
@ -710,7 +710,7 @@ ncqStorageRun ncq@NCQStorage{..} = flip runContT pure do
|
|||
|
||||
ncqFsync ncq fh
|
||||
size <- fdSeek fh SeekFromEnd 0
|
||||
writeBinaryFileDurable (ncqGetCurrentSizeName ncq) (N.bytestring64 (fromIntegral size))
|
||||
writeBinaryFileDurableAtomic (ncqGetCurrentSizeName ncq) (N.bytestring64 (fromIntegral size))
|
||||
|
||||
now1 <- getTimeCoarse
|
||||
atomically do
|
||||
|
@ -1202,7 +1202,7 @@ ncqOpenCurrent :: MonadUnliftIO m => NCQStorage -> m ()
|
|||
ncqOpenCurrent ncq@NCQStorage{..} = do
|
||||
let fp = ncqGetCurrentName ncq
|
||||
touch fp
|
||||
let flags = defaultFileFlags { exclusive = True }
|
||||
let flags = defaultFileFlags { exclusive = False, creat = Just 0o666 }
|
||||
fdw <- liftIO (PosixBase.openFd fp Posix.ReadWrite flags) <&> WFd
|
||||
fdr <- liftIO (PosixBase.openFd fp Posix.ReadOnly flags) <&> RFd
|
||||
atomically $ writeTVar ncqCurrentFd (Just (fdr, fdw))
|
||||
|
|
|
@ -46,6 +46,7 @@ import Data.Kind
|
|||
import Data.List (isPrefixOf)
|
||||
import Data.List qualified as List
|
||||
import Data.List ((\\))
|
||||
import Data.List.Split (chunksOf)
|
||||
import Data.Maybe
|
||||
import Data.Either
|
||||
import Data.String
|
||||
|
@ -1304,6 +1305,13 @@ internalEntries = do
|
|||
|
||||
_ -> throwIO (BadFormException @c nil)
|
||||
|
||||
|
||||
entry $ bindMatch "list:chunks" $ \case
|
||||
[ LitIntVal n, ListVal xs ] -> do
|
||||
pure $ mkList [ mkList es | es <- chunksOf (fromIntegral n) xs ]
|
||||
|
||||
_ -> throwIO (BadFormException @c nil)
|
||||
|
||||
entry $ bindMatch "group-by" $ \case
|
||||
[cmp, ListVal es] -> do
|
||||
let groupByM _ [] = pure []
|
||||
|
|
|
@ -97,6 +97,7 @@ library
|
|||
, safe
|
||||
, scientific
|
||||
, streaming
|
||||
, split
|
||||
, stm
|
||||
, text
|
||||
, time
|
||||
|
|
Loading…
Reference in New Issue