TCache 0.11.0.0 → 0.12.0

raw patch · 6 files changed

+167/−150 lines, 6 files

Files

• Data/Persistent/IDynamic.hs +139/−139
• Data/TCache.hs +7/−2
• Data/TCache/Defs.hs +5/−4
• Data/TCache/IndexQuery.hs +3/−3
• Data/TCache/IndexText.hs +1/−1
• TCache.cabal +12/−1

@@ -1,157 +1,157 @@-    {-# OPTIONS -XExistentialQuantification-            -XOverlappingInstances-            -XUndecidableInstances-            -XScopedTypeVariables-            -XDeriveDataTypeable-            -XTypeSynonymInstances-            -XIncoherentInstances-            -XOverloadedStrings-            -XMultiParamTypeClasses-            -XFunctionalDependencies-            -XFlexibleInstances #-}-{- |-IDynamic is a indexable and serializable version of Dynamic. (See @Data.Dynamic@). It is used as containers of objects-in the cache so any new datatype can be incrementally stored without recompilation.-IDimamic provices methods for safe casting,  besides serializaton, deserialirezation and retrieval by key.+    {-# OPTIONS -XExistentialQuantification
+            -XOverlappingInstances
+            -XUndecidableInstances
+            -XScopedTypeVariables
+            -XDeriveDataTypeable
+            -XTypeSynonymInstances
+            -XIncoherentInstances
+            -XOverloadedStrings
+            -XMultiParamTypeClasses
+            -XFunctionalDependencies
+            -XFlexibleInstances #-}
+{- |
+IDynamic is a indexable and serializable version of Dynamic. (See @Data.Dynamic@). It is used as containers of objects
+in the cache so any new datatype can be incrementally stored without recompilation.
+IDimamic provices methods for safe casting,  besides serializaton, deserialirezation and retrieval by key.
 -}
 module Data.Persistent.IDynamic where
 import Data.Typeable
 import Unsafe.Coerce
-import System.IO.Unsafe+import System.IO.Unsafe
 import Data.TCache
-import Data.TCache.Defs-import Data.RefSerialize-import Data.Char (showLitChar)--import Data.ByteString.Lazy.Char8 as B+import Data.TCache.Defs
+import Data.RefSerialize
+import Data.Char (showLitChar)
 
-import Data.Word-import Numeric (showHex, readHex)-import Control.Exception(handle, SomeException, ErrorCall)-import Control.Monad(replicateM)-import Data.Word-import Control.Concurrent.MVar-import Data.IORef-import Data.Map as M(empty)-import Data.RefSerialize----import Debug.Trace---(!>)= flip trace-+import Data.ByteString.Lazy.Char8 as B
 
-data IDynamic  =  IDyn  (IORef IDynType) deriving Typeable--data IDynType= forall a w r.(Typeable a, Serialize a)-               => DRight !a-             |  DLeft  !(ByteString ,(Context, ByteString))---               deriving Typeable--newtype Save= Save ByteString deriving Typeable+import Data.Word
+import Numeric (showHex, readHex)
+import Control.Exception(handle, SomeException, ErrorCall)
+import Control.Monad(replicateM)
+import Data.Word
+import Control.Concurrent.MVar
+import Data.IORef
+import Data.Map as M(empty)
+import Data.RefSerialize
 
-tosave d@(IDyn r)= unsafePerformIO $ do-   mr<- readIORef r-   case mr of-     DRight _ ->  return d-     DLeft (s,_) -> writeIORef r (DRight $ Save s) >> return d---instance Serialize Save  where-  showp (Save s)= insertString s-  readp = error "readp not impremented for Save"-+--import Debug.Trace
+--(!>)= flip trace
 
-errorfied str str2= error $ str ++ ": IDynamic object not reified: "++ str2- 
--dynPrefix= "Dyn"-dynPrefixSp= append  (pack dynPrefix) " "-notreified = pack $ dynPrefix ++" 0"----instance Serialize IDynamic where--   showp (IDyn t)=-    case unsafePerformIO $ readIORef t of-     DRight x -> do---          insertString $ pack dynPrefix-          c <- getWContext-          showpx  <-  rshowps x---          showpText . fromIntegral $ B.length showpx-          showp $ unpack showpx--     DLeft (showpx,_) ->   --  error $ "IDynamic not reified :: "++  unpack showpx---        insertString   notreified-          insertString  $ encode showpx-            where-            encode =   pack . show . unpack--   readp = lexeme (do---      symbol dynPrefix---      n <- readpText---      s <- takep n--      s <- rreadp :: STR  String--      c <- getRContext-      return . IDyn . unsafePerformIO . newIORef $ DLeft ( pack s, c))-      <?> "IDynamic"--+data IDynamic  =  IDyn  (IORef IDynType) deriving Typeable
 
+data IDynType= forall a w r.(Typeable a, Serialize a)
+               => DRight !a
+             |  DLeft  !(ByteString ,(Context, ByteString))
+
+
+               deriving Typeable
+
+newtype Save= Save ByteString deriving Typeable
+
+tosave d@(IDyn r)= unsafePerformIO $ do
+   mr<- readIORef r
+   case mr of
+     DRight _ ->  return d
+     DLeft (s,_) -> writeIORef r (DRight $ Save s) >> return d
+
+
+instance Serialize Save  where
+  showp (Save s)= insertString s
+  readp = error "readp not impremented for Save"
+
+
+errorfied str str2= error $ str ++ ": IDynamic object not reified: "++ str2
+
+
+
+dynPrefix= "Dyn"
+dynPrefixSp= append  (pack dynPrefix) " "
+notreified = pack $ dynPrefix ++" 0"
+
+
+
+instance Serialize IDynamic where
+
+   showp (IDyn t)=
+    case unsafePerformIO $ readIORef t of
+     DRight x -> do
+--          insertString $ pack dynPrefix
+          c <- getWContext
+          showpx  <-  rshowps x
+--          showpText . fromIntegral $ B.length showpx
+          showp $ unpack showpx
+
+     DLeft (showpx,_) ->   --  error $ "IDynamic not reified :: "++  unpack showpx
+--        insertString   notreified
+          insertString  $ encode showpx
+            where
+            encode =   pack . show . unpack
+
+   readp = lexeme (do
+--      symbol dynPrefix
+--      n <- readpText
+--      s <- takep n
+
+      s <- rreadp :: STR  String
+
+      c <- getRContext
+      return . IDyn . unsafePerformIO . newIORef $ DLeft ( pack s, c))
+      <?> "IDynamic"
+
+
+
 instance Show  IDynamic where
- show (IDyn r) =-    let t= unsafePerformIO $ readIORef r-    in case t of+ show (IDyn r) =
+    let t= unsafePerformIO $ readIORef r
+    in case t of
       DRight x -> "IDyn " ++  ( unpack . runW $ showp  x)
-      DLeft (s, _) ->  "IDyns \"" ++ unpack s ++ "\""----+      DLeft (s, _) ->  "IDyns \"" ++ unpack s ++ "\""
 
-toIDyn x= IDyn . unsafePerformIO . newIORef $ DRight x---- | check if a (possibly polimorphic) value within a IDynamic value has the given serialization"-serializedEqual (IDyn r) str= unsafePerformIO $ do-  t <- readIORef r-  case t of-   DRight x -> return $ runW (showp x) == str   -- !> ("R "++ (show $ unpack $ runW (showp x)))+
+
+
+
+toIDyn x= IDyn . unsafePerformIO . newIORef $ DRight x
+
+-- | check if a (possibly polimorphic) value within a IDynamic value has the given serialization"
+serializedEqual (IDyn r) str= unsafePerformIO $ do
+  t <- readIORef r
+  case t of
+   DRight x -> return $ runW (showp x) == str   -- !> ("R "++ (show $ unpack $ runW (showp x)))
    DLeft (str', _) -> return $ str== str'       -- !> ("L "++ (show $ unpack str' ))
   
-fromIDyn :: (Typeable a , Serialize a)=> IDynamic -> a-fromIDyn x= case safeFromIDyn x of+fromIDyn :: (Typeable a , Serialize a)=> IDynamic -> a
+fromIDyn x= case safeFromIDyn x of
           Left  s -> error s
-          Right v -> v--+          Right v -> v
+
+
 safeFromIDyn :: (Typeable a, Serialize a) => IDynamic -> Either String a       
-safeFromIDyn (d@(IDyn r))= final where- final= unsafePerformIO $ do-  t <- readIORef r-  case t of-   DRight x ->  return $ case cast x of-        Nothing -> Left $ "fromIDyn: unable to extract from "-                     ++ show d ++ " something of type: "-                     ++ (show . typeOf $ fromRight final)-        Just x  -> Right x-        where-        fromRight (Right x)= x---   DLeft (str, c) ->-    handle (\(e :: SomeException) ->  return $ Left (show e)) $  -- !> ("safeFromIDyn : "++ show e)) $-        do-          let v= runRC  c rreadp str    -- !> unpack str-          writeIORef r $! DRight v      -- !> ("***reified "++ unpack str)-          return $! Right v             -- !>  ("*** end reified " ++ unpack str)----reifyM :: (Typeable a,Serialize a) => IDynamic -> a -> IO a-reifyM dyn v = do-   let v'= fromIDyn dyn-   return $ v' `seq` v'+safeFromIDyn (d@(IDyn r))= final where
+ final= unsafePerformIO $ do
+  t <- readIORef r
+  case t of
+   DRight x ->  return $ case cast x of
+        Nothing -> Left $ "fromIDyn: unable to extract from "
+                     ++ show d ++ " something of type: "
+                     ++ (show . typeOf $ fromRight final)
+        Just x  -> Right x
+        where
+        fromRight (Right x)= x
+
+
+   DLeft (str, c) ->
+    handle (\(e :: SomeException) ->  return $ Left (show e)) $  -- !> ("safeFromIDyn : "++ show e)) $
+        do
+          let v= runRC  c rreadp str    -- !> unpack str
+          writeIORef r $! DRight v      -- !> ("***reified "++ unpack str)
+          return $! Right v             -- !>  ("*** end reified " ++ unpack str)
+
+
+
+reifyM :: (Typeable a,Serialize a) => IDynamic -> a -> IO a
+reifyM dyn v = do
+   let v'= fromIDyn dyn
+   return $ v' `seq` v'

@@ -341,7 +341,7 @@ -- |   Creates a new cache. Experimental newCache  :: IO (Ht , Integer) newCache =do-        c <- H.new -- (==) H.hashString+        c <- H.new  -- (==) H.hashString         return (c,0)  -- | Return the  total number of DBRefs in the cache. For debug purposes.@@ -473,9 +473,11 @@  getDBRef1 :: (Typeable a, IResource a) =>  String -> IO (DBRef a)  getDBRef1 key = do   (cache,_) <-  readIORef refcache   -- !> ("getDBRef "++ key)+  takeMVar getRefFlag   r <- H.lookup cache  key   case r of    Just (CacheElem  mdb w) -> do+     putMVar getRefFlag ()      mr <-  deRefWeak w      case mr of         Just dbref@(DBRef _ tv) ->@@ -487,11 +489,14 @@         Nothing -> finalize w >>  getDBRef1 key          -- !> "finalize"  -- the weak pointer has not executed his finalizer     Nothing -> do-     tv<- newTVarIO NotRead                              -- !> "Nothing"+     tv <- newTVarIO NotRead                              -- !> "Nothing"      dbref <- evaluate $ DBRef key  tv      w <- mkWeakPtr  dbref . Just $ fixToCache dbref      H.insert cache key (CacheElem Nothing w)+     putMVar getRefFlag ()      return  dbref++getRefFlag= unsafePerformIO $ newMVar ()  {- | Create the object passed as parameter (if it does not exist) and -- return its reference in the IO monad.

@@ -92,8 +92,8 @@  Read, Show,  instances are implicit instances of Serializable ->    serialize  = show->    deserialize= read+>    serialize  = pack . show+>    deserialize= read . unpack  Since write and read to disk of to/from the cache are not be very frequent The performance of serialization is not critical.@@ -125,7 +125,7 @@      , write       ::  (Key -> B.ByteString -> IO())   -- ^  write. It must be strict      , delete      ::  (Key -> IO())}                  -- ^  delete --- | Implements default persistence of objects in files with their keys as filenames+-- | Implements default default-persistence of objects in files with their keys as filenames filePersist   = Persist     {readByKey= defaultReadByKey     ,write    = defaultWrite@@ -133,7 +133,8 @@  defaultPersistIORef = unsafePerformIO $ newIORef  filePersist --- | Set the default persistence mechanism of all 'serializable' objetcts. By default it is 'filePersist'+-- | Set the default persistence mechanism of all 'serializable' objects that have+-- @setPersist= const Nothing@. By default it is 'filePersist' -- -- this statement must be the first one before any other TCache call setDefaultPersist p= writeIORef defaultPersistIORef p

@@ -100,12 +100,12 @@ import Data.ByteString.Lazy.Char8(pack, unpack)  -class (Read reg, Read a, Show reg, Show a+class (Read a,  Show a       , IResource reg,Typeable reg       , Typeable a,Ord a,PersistIndex reg)       => Queriable reg a -instance (Read reg, Read a, Show reg, Show a+instance (Read a,  Show a       , IResource reg,Typeable reg       , Typeable a,Ord a,PersistIndex reg)       => Queriable reg a@@ -136,7 +136,7 @@   -keyIndex treg tv= "index " ++ show treg ++ show tv+keyIndex treg tv= "index-" ++ show treg ++ show tv  instance (Typeable reg, Typeable a) => Indexable (Index reg a) where    key map= keyIndex typeofreg typeofa

@@ -102,7 +102,7 @@   setPersist=  const Nothing  instance  Indexable IndexText  where-   key (IndexText v _ _ _ _)=    "indextext " ++ v+   key (IndexText v _ _ _ _)=    "indextext-" ++ v  instance IResource IndexText where   keyResource = key

@@ -1,5 +1,5 @@ name: TCache-version: 0.11.0.0+version: 0.12.0 cabal-version: >= 1.6 build-type: Simple license: BSD3@@ -10,8 +10,19 @@              STM transactions for objects that syncronize  with their user-defined storages.              State in memory and into permanent storage is transactionally coherent.              .+             It has interface defined for Amazon WS and Yesod Persistent backends defined in tcache-<backend>+             packages.+             Persistent is a multi-backend interface for SQL and non SQL databases such in Mongo-db+             .              The package implements serializable STM references, access by key and by record field value, triggers,              full text and field indexation, default serialization and a query language based on record fields+             .+             Since the STM references can be included in data structures and serialized, this is right+             for graph databases and other NoSQL databases.+             .+             0.12.0 space in index data in indexQuery.hs and IndexText.hs triggered errors in the AWS backend.+             The space has been changed by '-'. So rename the "index *" files in the TCache folder+             in order to be recognized.              .              0.11.0.0 added setIndexParsist to define persistence for indexes by type. started the addition of readDBRefs, readResources and so on for simultaneous read, writes and deletes of              objects of the same type.