MasseR/addressbook
1
0
Fork 0
Code Issues 1 Pull Requests Releases Wiki Activity

Avoid unneeded writes

Browse Source
This commit is contained in:
Mats Rauhala 2021-11-04 10:10:35 +02:00
parent 03860c370a
commit 00e585281c
1 changed files with 7 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
src/Control/Addressbook/Streaming.hs
View File

@ -29,6 +29,7 @@ import qualified Data.ByteString.Lazy.Char8 as LBC
import System.IO.Unsafe (unsafeInterleaveIO) import System.IO.Unsafe (unsafeInterleaveIO)
import Control.Parallel.Strategies (rseq, parMap) import Control.Parallel.Strategies (rseq, parMap)
import qualified Data.List as L import qualified Data.List as L
import Control.Monad (unless)
combine :: (MonadUnliftIO m, MonadResource m, MonadThrow m, MonadIO m) => ConduitM FilePath Header m () combine :: (MonadUnliftIO m, MonadResource m, MonadThrow m, MonadIO m) => ConduitM FilePath Header m ()
combine = await >>= \case combine = await >>= \case
@ -47,11 +48,12 @@ run = do
original <- Set.fromList . map LBS.toStrict . lbsLines <$> LBS.readFile datFile original <- Set.fromList . map LBS.toStrict . lbsLines <$> LBS.readFile datFile
xs <- LBS.getContents >>= stream xs <- LBS.getContents >>= stream
let set = original `Set.union` F.fold (parMap rseq F.fold (chunks 20 xs)) let set = original `Set.union` F.fold (parMap rseq F.fold (chunks 20 xs))
runResourceT $ unless (original == set) $
runConduit $ runResourceT $
CL.sourceList (Set.elems set) runConduit $
.| C.map (<> "\n") CL.sourceList (Set.elems set)
.| CB.sinkFileCautious datFile .| C.map (<> "\n")
.| CB.sinkFileCautious datFile
where where
separate = \case separate = \case
From x -> [x] From x -> [x]