{-# 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))