diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2011, Jean-Marie Gaillourdet and Patrick Michel + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Jean-Marie Gaillourdet and Patrick Michel nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/global-variables.cabal b/global-variables.cabal new file mode 100644 --- /dev/null +++ b/global-variables.cabal @@ -0,0 +1,69 @@ +Name: global-variables +Version: 1.0 + +Synopsis: Namespaced, global, and top-level mutable variables without + unsafePerformIO. + +Description: + + 'Data.Global' provides a global namespace of 'IORef's, 'MVar's and + 'TVar's. This namespace may be accessed in pure code. Yet reading + and writing to those 'IORef's, 'MVar's and 'TVar's happens still in + their respective monads. + . + 'Data.Global' is designed to meet the following use cases: + . + * Simplify the declaration of top-level mutable variables, by + avoiding any pragmas as well as 'unsafePerformIO'. + . + * Avoid having to pass references explicitly throughout the + program in order to let distant parts communicate. + . + * Enable a communication by convention scheme, where + e.g. different libraries may communicate without code + dependencies. + . + * Simplify the \"configuration problem\" - at least for code in the + IO monad. + . + Note, that this library does not encourage sloppy software design + by re-introducing all bad effects of global + variables. Nevertheless, sometimes global variables are a suitable + solution to a problem. In that case "Data.Global" simplifies and + extends their handling significantly. + . + Examples are in the documentation of "Data.Global". + +License: BSD3 +License-file: LICENSE +Author: Jean-Marie Gaillourdet and Patrick Michel +Maintainer: Jean-Marie Gaillourdet +Copyright: 2011 Jean-Marie Gaillourdet +Bug-Reports: http://bitbucket.org/jmg/global-variables/issues +Stability: stable + +Category: Data, Reflection + +Build-type: Simple + +-- Extra files to be distributed with the package, such as examples or +-- a README. +-- Extra-source-files: + +Cabal-version: >=1.6 + +Library + Exposed-modules: Data.Global + Hs-Source-Dirs: src + + Build-depends: base >= 4 && < 5 + , containers >= 0.3 && < 0.5 + , stm >= 2.1 && < 2.2 + + Other-modules: Data.Global.Registry + + Ghc-Options: -Wall + +Source-Repository head + Type: mercurial + Location: http://bitbucket.org/jmg/global-variables diff --git a/src/Data/Global.hs b/src/Data/Global.hs new file mode 100644 --- /dev/null +++ b/src/Data/Global.hs @@ -0,0 +1,93 @@ +-- -*- encoding: utf-8; fill-column: 95 -*- + +----------------------------------------------------------------------------------------------- +-- +-- Module : Data.Global +-- Creation Date : 2011-09-01 +-- Authors : Jean-Marie Gaillourdet +-- License : BSD-style +-- Portability : all +-- +-- +----------------------------------------------------------------------------------------------- + +-- | 'Data.Global' provides a global namespace of 'IORef's, 'MVar's and 'TVar's. This namespace +-- may be accessed in pure code. Yet reading and writing to those 'IORef's, 'MVar's and 'TVar's +-- happens still in their respective monads. +-- +-- 'Data.Global' is designed to meet the following use cases: +-- +-- * Simplify the declaration of top-level mutable variables, by avoiding any pragmas as well +-- as 'unsafePerformIO'. +-- +-- * Avoid having to pass references explicitly throughout the program in order to let +-- distant parts communicate. +-- +-- * Enable a communication by convention scheme, where e.g. different libraries may +-- communicate without code dependencies. +-- +-- * Simplify the "configuration problem" - at least for code in the IO monad. +-- +-- Note, that this library does not encourage sloppy software design by re-introducing all bad +-- effects of global variables. Nevertheless, sometimes global variables are a suitable +-- solution to a problem. In that case 'Data.Global' simplifies and extends their handling +-- significantly. +module Data.Global ( + + -- * Introductory Example + -- $intro + + -- * The Namespace of Global Variables + -- $namespace + + -- * Initialization + -- $init + + -- * Reference of Variable Declaration Functions + declareIORef + , declareMVar + , declareTVar + +) where + +import Data.Global.Registry + + + +-- $intro +-- +-- The most simple usage of 'Data.Global' is as follows: +-- +-- Let there be an 'IORef'! +-- +-- >>> let ref = declareIORef \"some-cool-variable\" 17 +-- +-- Use @ref@ like any other 'IORef'. +-- +-- >>> readIORef ref +-- 17 +-- +-- You can do the same with 'MVar's and 'TVar's. + + + +-- $namespace +-- The types of variables: @'IORef' a@, @'MVar' a@, and @'TVar' a@ create separate +-- namespaces. I.e. A variable of type @'IORef' 'Int'@ and one of type @'MVar' 'Int'@ can both +-- exist with the same name. + + + +-- $init +-- References / variables returned by any of the @declare...@ functions are initialized +-- as needed with the value provided to @declare...@. Have a look at this example. +-- +-- @ +-- someVar1, someVar2 :: IORef Int +-- someVar1 = declareIORef \"my-global-var\" 0 +-- someVar2 = declareIORef \"my-global-var\" 1 +-- @ +-- +-- @someVar1@ and @someVar2@ are guaranteed to always denote the exact same 'IORef', but it is +-- unspecified whether the first read access to that 'IORef' returns @0@ or @1@. It can even +-- have any other initial value if it is also accessed from some other part of the program. diff --git a/src/Data/Global/Registry.hs b/src/Data/Global/Registry.hs new file mode 100644 --- /dev/null +++ b/src/Data/Global/Registry.hs @@ -0,0 +1,211 @@ +-- -*- encoding: utf-8; fill-column: 95 -*- + +{-# LANGUAGE CPP, ScopedTypeVariables #-} +----------------------------------------------------------------------------------------------- +-- | +-- Module : Data.Global.Registry +-- Creation Date : 2011-09-01 +-- Authors : Jean-Marie Gaillourdet +-- License : BSD-style +-- Portability : all +-- +-- The internal module. +----------------------------------------------------------------------------------------------- +module Data.Global.Registry ( + -- * Public Interface + declareIORef, declareMVar, declareTVar + + -- * Private Testing Interface + , lookupOrInsert + , setupRegistry +) where + +#if __GLASGOW_HASKELL__ < 702 +import Control.Exception ( evaluate ) +#endif +import Control.Concurrent.MVar +import Control.Concurrent.STM +import Data.IORef +import Data.Dynamic +import Data.Map as M +import GHC.Conc (pseq) + +import System.IO.Unsafe + + +#if __GLASGOW_HASKELL__ >= 702 +type Registry = Map (TypeRep,TypeRep,String) Dynamic +#else +type Registry = Map (Int,Int,String) Dynamic +#endif + +-- | Test helper +setupRegistry :: IO (MVar Registry) +setupRegistry = m `pseq` newMVar m + where + m = M.empty + + + +{-# NOINLINE globalRegistry #-} +globalRegistry :: MVar Registry +globalRegistry = m `pseq` unsafePerformIO (newMVar m) + where + m = M.empty + + +-- TODO: add a proper assertion explaining the problem + +-- | Exposed for unit testing +lookupOrInsert + :: forall a. forall ref. (Typeable a, Typeable1 ref) + => MVar Registry + -> (a -> IO (ref a)) + -> String + -> a + -> IO (ref a) +lookupOrInsert registry new name val + | registry `pseq` new `pseq` name `pseq` val `pseq` False = undefined +lookupOrInsert registry new name val = modifyMVar registry lkup + where + err ex got = error $ "Data.Global.Registry: Invariant violation\n" + ++ "expected: " ++ show ex ++ "\n" + ++ "got: " ++ show got ++ "\n" + +#if __GLASGOW_HASKELL__ >= 702 + typVal = typeOf val + typRef = typeOf (undefined :: ref ()) -- TypeRep representing the reference, e.g. IORef, + -- MVar + + lkup :: Registry -> IO (Registry, ref a) + lkup reg = case M.lookup (typRef, typVal, name) reg of + Just ref -> return (reg, fromDyn ref (err typVal (dynTypeRep ref))) + Nothing -> + do { ref <- new val + ; return (M.insert (typRef, typVal, name) (toDyn ref) reg, ref) + } +#else + lkup :: Registry -> IO (Registry, ref a) + lkup reg = + do { typVal <- typeOf' val + ; typRef <- typeOf' (undefined :: ref ()) -- TypeRep representing the reference, + -- e.g. IORef, MVar + ; typValIdx <- typeRepKey typVal + ; typRefIdx <- typeRepKey typRef + ; case M.lookup (typRefIdx, typValIdx, name) reg of + Just ref -> return (reg, fromDyn ref (err typVal (dynTypeRep ref))) + Nothing -> + do { ref <- new val + ; _ <- typeOf' ref + ; return (M.insert (typRefIdx, typValIdx, name) (toDyn ref) reg, ref) + } + } + +{-# NOINLINE lock #-} +lock :: MVar () +lock = unsafePerformIO $ newMVar () + +-- Ugly workaround to http://hackage.haskell.org/trac/ghc/ticket/5540 +typeOf' :: Typeable a => a -> IO TypeRep +typeOf' x = + do { lock' <- evaluate lock + ; () <- takeMVar lock' + ; t <- evaluate $ typeOf x + ; putMVar lock' () + ; return t + } + +#endif + +{-# NOINLINE lookupOrInsert #-} + + +lookupOrInsertIORef + :: Typeable a + => String + -> a + -> IO (IORef a) +lookupOrInsertIORef = lookupOrInsert globalRegistry newIORef +{-# NOINLINE lookupOrInsertIORef #-} + + + +lookupOrInsertMVar + :: Typeable a + => String + -> a + -> IO (MVar a) +lookupOrInsertMVar = lookupOrInsert globalRegistry newMVar +{-# NOINLINE lookupOrInsertMVar #-} + + + +lookupOrInsertTVar + :: Typeable a + => String + -> a + -> IO (TVar a) +lookupOrInsertTVar = lookupOrInsert globalRegistry newTVarIO +{-# NOINLINE lookupOrInsertTVar #-} + + +-- | @declareIORef name val@ maps a variable name to an 'IORef'. Calling it multiple times with the same +-- @name@ and type of 'val' will always return the same 'IORef'. +-- +-- @ +-- someVar :: IORef Int +-- someVar = declareMVar \"my-global-some-var\" 0 +-- @ +-- +-- Note, there is /no/ need to use 'unsafePerformIO' or to add a @{-\# NOINLINE someVar \#-}@ +-- pragma in order to define top-level 'IORef's. +declareIORef + :: Typeable a + => String -- ^ The identifying name + -> a -- ^ The initial value of the 'IORef', it may or may not be used. + -> (IORef a) -- ^ A unique 'IORef' determined by @(name, typeOf val)@. Whether it refers + -- to the given initial value or not is unspecified. +declareIORef name val = unsafePerformIO $ lookupOrInsertIORef name val +{-# NOINLINE declareIORef #-} + + + +-- | @declareMVar name val@ maps a variable name to an 'MVar'. Calling it multiple times with the same +-- @name@ and type of 'val' will always return the same 'MVar'. +-- +-- @ +-- someVar :: MVar Int +-- someVar = declareMVar \"my-global-some-var\" 0 +-- @ +-- +-- Note, there is /no/ need to use 'unsafePerformIO' or to add a @{-\# NOINLINE someVar \#-}@ +-- pragma in order to define top-level 'MVar's. +declareMVar + :: Typeable a + => String -- ^ The identifying name + -> a -- ^ The initial value of the 'MVar', it may or may not be used. + -> (MVar a) -- ^ A unique 'MVar' determined by @(name, typeOf val)@. Whether it refers to + -- the given initial value or not is unspecified. +declareMVar name val = unsafePerformIO $ lookupOrInsertMVar name val +{-# NOINLINE declareMVar #-} + + + +-- | @declareTVar name val@ maps a variable name to an 'TVar'. Calling it multiple times with the same +-- @name@ and type of 'val' will always return the same 'TVar'. +-- +-- @ +-- someVar :: TVar Int +-- someVar = declareMVar \"my-global-some-var\" 0 +-- @ +-- +-- Note, there is /no/ need to use 'unsafePerformIO' or to add a @{-\# NOINLINE someVar \#-}@ +-- pragma in order to define top-level 'TVar's. +declareTVar + :: Typeable a + => String -- ^ The identifying name + -> a -- ^ The initial value of the 'TVar', it may or may not be used. + -> (TVar a) -- ^ A unique 'TVar' determined by @(name, typeOf val)@. Whether it refers to + -- the given initial value or not is unspecified. +declareTVar name val = unsafePerformIO $ lookupOrInsertTVar name val +{-# NOINLINE declareTVar #-}