dictionary-sharing (empty) → 0.1.0.0

raw patch · 4 files changed

+143/−0 lines, 4 filesdep +basedep +containerssetup-changed

Dependencies added: base, containers

Files

• Data/ClassSharing.hs +84/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• dictionary-sharing.cabal +27/−0

@@ -0,0 +1,84 @@+-- {-#LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving#-}
+module Data.ClassSharing 
+  ( Shared, Shareable(..), share, unsafeAccess
+  , runShared, Ref, DynMap, newRef, unsafeNewRef
+  , Typeable
+  ) where
+
+import Control.Applicative
+import System.IO.Unsafe
+import System.IO
+import Control.Monad.Fix
+import Data.IORef
+import qualified Data.Map as M
+import Data.Typeable
+import Data.Dynamic
+
+type Ref = IORef DynMap
+newtype Shared f a = Shared (Shareable f a)
+newtype Shareable f a = Shareable {run :: (Ref -> f a)}
+
+
+runShared :: Shared f a -> Ref -> f a
+runShared (Shared x) = run x
+
+-- | Share/memoize a class member of type @f a@. 
+share :: (Typeable a, Typeable f) => Shareable f a -> Shared f a
+share x = Shared (Shareable $ \r -> memo (run x r) r) where
+  memo x r = unsafePerformIO (protect x r)
+
+-- | Should only be used to access class members. A safe wrapper should be defined for every shared class member. Direct access can lead to overriding class member definitions. 
+unsafeAccess :: Shared f a -> Shareable f a
+unsafeAccess (Shared x) = x
+
+
+instance Functor f => Functor (Shareable f) where
+  fmap f = Shareable . (fmap $ fmap f) . run
+
+instance Applicative f => Applicative (Shareable f) where
+  pure                         = Shareable . pure . pure
+  Shareable a <*> Shareable b  = Shareable (\r -> a r <*> b r)
+
+instance Alternative f => Alternative (Shareable f) where
+  empty = Shareable (const empty)
+  Shareable a <|> Shareable b  = Shareable (\r -> a r <|> b r)
+
+unsafeNewRef :: () -> Ref
+{-# INLINE unsafeNewRef #-}
+unsafeNewRef () = unsafePerformIO 
+  (-- putStrLn "Initiating global variable" >>
+  newRef)
+
+newRef :: IO Ref
+newRef = newIORef dynEmpty
+
+protect :: Typeable a => a -> Ref -> IO a
+protect x ref = do
+  m <- readIORef ref
+  case dynLookup m of
+    Just y   ->  -- putStrLn ("Accessing: " ++ (show $ typeOf x)) >> 
+                 return y
+    Nothing  ->  
+                 -- putStrLn ("Initializing: " ++ (show $ typeOf x)) >> 
+                 writeIORef ref (dynInsert x m) >> return x
+
+-- |  A dynamic map with type safe
+-- insertion and lookup.
+newtype DynMap = 
+  DynMap (M.Map TypeRep Dynamic) 
+  deriving Show
+
+dynEmpty :: DynMap
+dynEmpty = DynMap M.empty  
+  
+dynInsert :: Typeable a => a -> DynMap -> DynMap
+dynInsert a (DynMap m) = DynMap (M.insert (typeOf a) (toDyn a) m)
+
+dynLookup :: Typeable a => DynMap -> Maybe a
+dynLookup (DynMap m) = hlp fun (error "Data.ClassSharing: This is not supposed to be inspected") where 
+    hlp :: Typeable a => 
+      (TypeRep -> Maybe a) -> a -> Maybe a
+    hlp f a = f (typeOf a)
+    fun tr = M.lookup tr m >>= fromDynamic
+
+

@@ -0,0 +1,30 @@+Copyright (c) 2015, Jonas Dureg†rd
+
+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 Jonas Dureg†rd 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.

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

@@ -0,0 +1,27 @@+
+name:                dictionary-sharing
+version:             0.1.0.0
+synopsis:            Sharing/memoization of class members
+description:         Library for ensuring that class members are shared.
+license:             BSD3
+license-file:        LICENSE
+author:              Jonas Duregård
+maintainer:          jonas.duregard@chalmers.se
+-- copyright:           
+
+category:            Development
+build-type:          Simple
+-- extra-source-files:  
+cabal-version:       >=1.10
+
+source-repository head   
+  type:      git
+  location:  https://github.com/JonasDuregard/dictionary-sharing
+
+library
+  exposed-modules:     Data.ClassSharing
+  -- other-modules:       
+  -- other-extensions:    
+  build-depends:       base >=4.7 && <5, containers >=0.5 && <0.6
+  -- hs-source-dirs:      
+  default-language:    Haskell2010