builder/src/BackgroundWriter.hs · elk

on master help sign in

elk/builder/src/BackgroundWriter.hs

42 lines 907 B history raw

1{-# LANGUAGE BangPatterns #-}

2module BackgroundWriter

3 ( Scope

4 , withScope

5 , writeBinary

6 )

7 where

10import Control.Concurrent (forkIO)

11import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)

12import qualified Data.Binary as Binary

13import Data.Foldable (traverse_)

15import qualified File

19-- BACKGROUND WRITER

22newtype Scope =

23 Scope (MVar [MVar ()])

26withScope :: (Scope -> IO a) -> IO a

27withScope callback =

28 do workList <- newMVar []

29 result <- callback (Scope workList)

30 mvars <- takeMVar workList

31 traverse_ takeMVar mvars

32 return result

35writeBinary :: (Binary.Binary a) => Scope -> FilePath -> a -> IO ()

36writeBinary (Scope workList) path value =

37 do mvar <- newEmptyMVar

38 _ <- forkIO (File.writeBinary path value >> putMVar mvar ())

39 oldWork <- takeMVar workList

40 let !newWork = mvar:oldWork

41 putMVar workList newWork