packages feed

global-variables (empty) → 1.0

raw patch · 5 files changed

+405/−0 lines, 5 filesdep +basedep +containersdep +stmsetup-changed

Dependencies added: base, containers, stm

Files

+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ global-variables.cabal view
@@ -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 <jmg@gaillourdet.net>+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
+ src/Data/Global.hs view
@@ -0,0 +1,93 @@+-- -*- encoding: utf-8; fill-column: 95 -*-++-----------------------------------------------------------------------------------------------+--+-- Module        : Data.Global+-- Creation Date : 2011-09-01+-- Authors       : Jean-Marie Gaillourdet <jmg@gaillourdet.net>+-- 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.
+ src/Data/Global/Registry.hs view
@@ -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 <jmg@gaillourdet.net>+-- 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 #-}