blob: 60ea435bd56f7d3fe5770abc271c943b0ec301e6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
|
{-# LANGUAGE TemplateHaskellQuotes #-}
module InitOnce (once) where
import Language.Haskell.TH (bindCode, CodeQ)
import Type.Reflection (Typeable, typeOf)
import InitOnce.TheMap (onceInsert)
import InitOnce.Types (Location, location', TypedAny(..), getTypedAny)
-- | The IO action is executed with asynchronous exceptions masked (using
-- 'Control.Concurrent.MVar.modifyMVarMasked') to ensure that initialisation
-- really happens once.
once :: Typeable a => CodeQ (IO a) -> CodeQ a
once code = bindCode location' $ \loc -> [|| typedOnceInsert loc $$(code) ||]
typedOnceInsert :: Typeable a => Location -> IO a -> a
typedOnceInsert loc act = getTypedAny (onceInsert loc ((\x -> TypedAny (typeOf x) x) <$> act))
|
