From 75ba6aeef88df2f051b73aa916fb66ce4c6b8a14 Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Wed, 1 Jul 2026 22:48:53 +0100 Subject: Initial --- src/InitOnce.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) create mode 100644 src/InitOnce.hs (limited to 'src/InitOnce.hs') 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)) -- cgit v1.3.1