Solved bugs in IndexText

Data/Persistent/Collection.hs

@@ -34,7 +34,7 @@ RefQueue(..), getQRef,
 pop,popSTM,pick, flush, flushSTM,
 pickAll, pickAllSTM, push,pushSTM,
 pickElem, pickElemSTM,  readAll, readAllSTM,
-deleteElem, deleteElemSTM,
+deleteElem, deleteElemSTM,updateElem,updateElemSTM,
 unreadSTM,isEmpty,isEmptySTM
 ) where
 import Data.Typeable
@@ -89,6 +89,7 @@ instance   Serialize a => Serializable (Queue a ) where
 -- | A queue reference
 type RefQueue a= DBRef (Queue a)
 
+-- | push an element at the top of the queue
 unreadSTM :: (Typeable a, Serialize a) => RefQueue a -> a -> STM ()
 unreadSTM queue x= do
     r <- readQRef queue

Data/Persistent/IDynamic.hs

@@ -120,27 +120,32 @@ toIDyn x= IDyn . unsafePerformIO . newIORef $ DRight x
 fromIDyn :: (Typeable a , Serialize a)=> IDynamic -> a
 fromIDyn x=r where
   r = case safeFromIDyn x of
-          Nothing -> error $ "fromIDyn: casting failure for data "
-                     ++ show x ++ " to type: "
-                     ++ (show $ typeOf r)
-          Just v -> v
+          Left s -> error s
+          Right v -> v
 
 
-safeFromIDyn :: (Typeable a, Serialize a) => IDynamic -> Maybe a       
-safeFromIDyn (IDyn r)=unsafePerformIO $ do
+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 $ cast x
+   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 Nothing) $  -- !> ("safeFromIDyn : "++ show e)) $
+    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 $! Just v -- !>  ("*** end reified " ++ unpack str)
+          return $! Right v -- !>  ("*** end reified " ++ unpack str)
 
 
---main= print (safeFromIDyn $ IDyn $ unsafePerformIO $ newIORef $ DLeft $ (pack "1", (unsafePerformIO $ HT.new (==) HT.hashInt, pack "")) :: Maybe Int)
 
 reifyM :: (Typeable a,Serialize a) => IDynamic -> a -> IO a
 reifyM dyn v = do

Data/TCache.hs

@@ -365,13 +365,13 @@ writeDBRef dbref@(DBRef key  tv) x= x `seq` do
 
 
 instance  Show (DBRef a) where
-  show (DBRef  key _)=   "getDBRef \""++ key ++ "\""
+  show (DBRef  key _)=   "DBRef \""++ key ++ "\""
 
 instance  (IResource a, Typeable a) => Read (DBRef a) where
     readsPrec n str1= readit str
        where
        str = dropWhile isSpace str1
-       readit ('g':'e':'t':'D':'B':'R':'e':'f':' ':'\"':str1)=
+       readit ('D':'B':'R':'e':'f':' ':'\"':str1)=
          let   (key,nstr) =  break (== '\"') str1
          in  [( getDBRef key :: DBRef a, tail  nstr)]
        readit  _ = []

Data/TCache/Defs.hs

@@ -65,8 +65,8 @@ instance Indexable Car where key Car{cname= n} = \"Car \" ++ n
 class Indexable a where
     key:: a -> String
     defPath :: a -> String       -- ^ additional extension for default file paths.
-                                -- IMPORTANT:  defPath must depend on the datatype, not the value (must be constant). Default is "TCacheData/"
-    defPath =  const "TCacheData/"
+                                -- IMPORTANT:  defPath must depend on the datatype, not the value (must be constant). Default is ".tcachedata/"
+    defPath =  const ".tcachedata/"
 
 --instance IResource a => Indexable a where
 --   key x= keyResource x

Data/TCache/IResource.hs

@@ -6,7 +6,6 @@ import Data.Typeable
 import System.IO.Unsafe
 import Control.Concurrent.STM
 import Control.Concurrent
-import System.Directory
 import Control.Exception as Exception
 import System.IO
 import System.IO.Error

Data/TCache/IndexQuery.hs

@@ -117,7 +117,7 @@ instance (Queriable reg a) => Serializable (Index reg a)  where
   deserialize= read . unpack
 
 
-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

Data/TCache/IndexText.hs

@@ -95,7 +95,7 @@ instance Serializable IndexText  where
   deserialize= read . unpack
 
 instance  Indexable IndexText  where
-   key (IndexText v _ _ _ _)=    "IndexText " ++ v
+   key (IndexText v _ _ _ _)=    "indextext " ++ v
 
 instance IResource IndexText where
   keyResource = key

Data/TCache/Memoization.hs

@@ -15,7 +15,7 @@
             , ExistentialQuantification
             , FlexibleInstances
             , TypeSynonymInstances  #-}
-module Data.TCache.Memoization (cachedByKey,flushCached,cachedp,addrStr,Executable(..))
+module Data.TCache.Memoization (writeCached,cachedByKey,flushCached,cachedp,addrStr,Executable(..))
 
 where
 import Data.Typeable
@@ -60,11 +60,11 @@ instance MonadIO Identity where
 cachedKeyPrefix = "cached"
 
 instance  (Indexable a) => IResource (Cached a  b) where
-  keyResource ch@(Cached a  f _ _)= cachedKeyPrefix ++ key a   -- ++ unsafePerformIO (addrStr f )
+  keyResource ch@(Cached a  _ _ _)= cachedKeyPrefix ++ key a   -- ++ unsafePerformIO (addrStr f )
 
   writeResource _= return ()
   delResource _= return ()
-  readResourceByKey=   error "access By Indexable is undefined for cached objects"
+  readResourceByKey k=   error $ "access By key is undefined for cached objects.key= " ++ k
 
 
   readResource (Cached a f _ _)=do
@@ -83,6 +83,17 @@ instance  (Indexable a) => IResource (Cached a  b) where
 -- such  web pages composed on the fly.
 --
 -- time == 0 means infinite
+
+--getCachedRef :: (Indexable a,Typeable a, Typeable b) => a -> DBRef (Cached a b)
+--getCachedRef x = getDBRef $ keyResource (Cached x (u u u) where u= undefined
+
+writeCached
+  :: (Typeable b, Typeable a, Indexable a, Executable m) =>
+     a -> (a -> m b) -> b -> Integer -> STM ()
+writeCached  a b c d=
+    withSTMResources [] . const $ resources{toAdd= [Cached a b c d] }
+
+
 cached ::  (Indexable a,Typeable a,  Typeable b, Executable m,MonadIO m) => Int -> (a -> m b) -> a  -> m b
 cached time  f a=  do
    let prot= Cached a f undefined undefined