summaryrefslogtreecommitdiff
path: root/src/InitOnce.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/InitOnce.hs')
-rw-r--r--src/InitOnce.hs18
1 files changed, 18 insertions, 0 deletions
diff --git a/src/InitOnce.hs b/src/InitOnce.hs
new file mode 100644
index 0000000..60ea435
--- /dev/null
+++ b/src/InitOnce.hs
@@ -0,0 +1,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))