Cleaned it up and started to bring it up to date

- removed various data cache directories
- converted files with mixed tabs/spaces
- removed trailing and empy line whitespace
- added a .gitignore file
- added a simple stack.yaml
- added a simple script to build the demos
- added a script to cleanup .tcachedata folders
- Demos compile with Stack lts-13.x / GHC 8.6.4
  - remmoved deprecated language extensions (no code changes)
  - blindly "fixed" one demo which had no main.
  - made DBRef.hs compile
  - made DynamicSample.hs compile

.gitignore

@@ -0,0 +1,6 @@
+.tcachedata
+.stack-work
+*.hi
+*.o
+demos/bin/*
+demos/.build

Data/Persistent/IDynamic.hs

@@ -1,5 +1,4 @@
     {-# OPTIONS -XExistentialQuantification
-            -XOverlappingInstances
             -XUndecidableInstances
             -XScopedTypeVariables
             -XDeriveDataTypeable
@@ -121,14 +120,14 @@ serializedEqual (IDyn r) str= unsafePerformIO $ do
   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
           Left  s -> error s
           Right v -> v
 
 
-safeFromIDyn :: (Typeable a, Serialize a) => IDynamic -> Either String a       
+safeFromIDyn :: (Typeable a, Serialize a) => IDynamic -> Either String a
 safeFromIDyn (d@(IDyn r))= final where
  final= unsafePerformIO $ do
   t <- readIORef r

Data/TCache.hs

@@ -713,7 +713,7 @@ getResource r= do{mr<- getResources [r];return $! head mr}
 getResources:: (IResource a, Typeable a)=>[a]-> IO [Maybe a]
 getResources rs= atomically $ withSTMResources rs f1 where
   f1 mrs= Resources  [] [] mrs
-		
+
 
 -- | Delete the   resource from cache and from persistent storage.
 --
@@ -781,33 +781,33 @@ releaseTPVars rs cache = mapM_  (releaseTPVar cache)  rs
 
 releaseTPVar :: (IResource a,Typeable a)=>  Ht -> a  -> STM ()
 releaseTPVar cache  r =do
-	c <- unsafeIOToSTM $ H.lookup cache keyr
-	case c of
-	    Just  (CacheElem    _ w) -> do
-	        mr <-  unsafeIOToSTM $ deRefWeak w
-	        case mr of
-	            Nothing -> unsafeIOToSTM (finalize w) >> releaseTPVar cache  r		
-	            Just dbref@(DBRef key  tv) -> do
-	            applyTriggers [dbref] [Just (castErr r)]
+        c <- unsafeIOToSTM $ H.lookup cache keyr
+        case c of
+            Just  (CacheElem    _ w) -> do
+                mr <-  unsafeIOToSTM $ deRefWeak w
+                case mr of
+                    Nothing -> unsafeIOToSTM (finalize w) >> releaseTPVar cache  r
+                    Just dbref@(DBRef key  tv) -> do
+                    applyTriggers [dbref] [Just (castErr r)]
                     t <- unsafeIOToSTM  timeInteger
-                    writeTVar tv . Exist  $ Elem  (castErr r)  t t	
-
+                    writeTVar tv . Exist  $ Elem  (castErr r)  t t
+
+
+            Nothing   ->  do
+                ti  <- unsafeIOToSTM timeInteger
+                tvr <- newTVar NotRead
+                dbref <- unsafeIOToSTM . evaluate $ DBRef keyr  tvr
+                applyTriggers [dbref] [Just r]
+                writeTVar tvr . Exist $ Elem r ti ti
+                w <- unsafeIOToSTM . mkWeakPtr dbref $ Just $ fixToCache dbref
+                unsafeIOToSTM $ H.insert cache keyr (CacheElem (Just dbref) w)-- accesed and modified XXX
+                return ()
+
+
+        where keyr= keyResource r
 
-	    Nothing   ->  do
-	        ti  <- unsafeIOToSTM timeInteger
-	        tvr <- newTVar NotRead
-	        dbref <- unsafeIOToSTM . evaluate $ DBRef keyr  tvr
-	        applyTriggers [dbref] [Just r]
-	        writeTVar tvr . Exist $ Elem r ti ti
-	        w <- unsafeIOToSTM . mkWeakPtr dbref $ Just $ fixToCache dbref
-	        unsafeIOToSTM $ H.insert cache keyr (CacheElem (Just dbref) w)-- accesed and modified XXX
-	        return ()				
-
-
-	where 	keyr= keyResource r
 
 
-
 
 delListFromHash :: IResource a => Ht -> [a] -> STM ()
 delListFromHash  cache  xs= mapM_ del xs
@@ -829,7 +829,7 @@ delListFromHash  cache  xs= mapM_ del xs
 
 
 updateListToHash hash kv= mapM (update1 hash) kv where
-	update1 h (k,v)= H.insert h k v
+        update1 h (k,v)= H.insert h k v
 
 
 
@@ -847,8 +847,8 @@ clearSyncCacheProc  time check sizeObjects= forkIO  clear
  clear = do
      threadDelay $ time * 1000000
      handle ( \ (e :: SomeException)-> hPutStr stderr (show e) >> clear ) $ do
-    	clearSyncCache   check sizeObjects                                        -- !>  "CLEAR"
-    	clear
+            clearSyncCache   check sizeObjects                                        -- !>  "CLEAR"
+            clear
 
 criticalSection mv f= bracket
   (takeMVar mv)
@@ -932,7 +932,7 @@ clearSyncCache check sizeObjects= criticalSection saving $ do
 
         -- delete elems from the cache according with the checking criteria
   filtercache t cache lastSync elems= mapM_ filter elems
-    where	
+    where
     filter (CacheElem Nothing w)= return()  --alive because the dbref is being referenced elsewere
     filter (CacheElem (Just (DBRef key _)) w) = do
      mr <-  deRefWeak w
@@ -941,13 +941,13 @@ clearSyncCache check sizeObjects= criticalSection saving $ do
        Just (DBRef _  tv) -> atomically $ do
          r <- readTVar tv
          case r of
-    		Exist (Elem x lastAccess _ ) ->
-            		 if check t lastAccess lastSync
-            		      then do
+                    Exist (Elem x lastAccess _ ) ->
+                             if check t lastAccess lastSync
+                              then do
                               unsafeIOToSTM . H.insert cache key $ CacheElem Nothing w
                               writeTVar tv NotRead
-            		      else return ()
-    		_    ->  return()
+                                  else return ()
+                    _    ->  return()
 
 
 
@@ -962,8 +962,8 @@ defaultCheck
        -> Integer    -- ^ last cache syncronization (with the persisten storage)
        -> Bool       -- ^ return true for all the elems not accesed since half the time between now and the last sync
 defaultCheck  now lastAccess lastSync
-	| lastAccess > halftime = False
-	| otherwise  = True
+        | lastAccess > halftime = False
+        | otherwise  = True
 
     where
     halftime= now- (now-lastSync) `div` 2
@@ -1002,9 +1002,9 @@ extract elems lastSave= filter1 [] [] (0:: Int)  elems
           r <- readTVar tvr
           case r of
             Exist (Elem r _ modTime) ->
-        	  if (modTime >= lastSave)
-        	    then filter1 (Filtered r:sav) tofilter (n+1) rest
-        	    else filter1 sav tofilter (n+1) rest -- !> ("rejected->" ++ keyResource r)
+                  if (modTime >= lastSave)
+                    then filter1 (Filtered r:sav) tofilter (n+1) rest
+                    else filter1 sav tofilter (n+1) rest -- !> ("rejected->" ++ keyResource r)
 
             _ -> filter1 sav tofilter (n+1) rest
 

Data/TCache/IResource.hs

@@ -16,23 +16,23 @@ import Data.List(isInfixOf)
 
 {- | Must be defined for every object to be cached.
 -}
-class IResource a where 
-        {- The `keyResource string must be a unique  since this is used to index it in the hash table. 
+class IResource a where
+        {- The `keyResource string must be a unique  since this is used to index it in the hash table.
         when accessing a resource, the user must provide a partial object for wich the key can be obtained.
         for example:
-        
+
         @data Person= Person{name, surname:: String, account :: Int ....)
-        
+
         keyResource Person n s ...= n++s@
-        
+
         the data being accesed must define the fields used by keyResource. For example
 
          @  readResource Person {name="John", surname= "Adams"}@
-        
+
         leaving the rest of the fields undefined
 
         when using default file persistence, the key is used as file name. so it must contain valid filename characters
-        
+
         -}
         keyResource :: a -> String             -- ^ must be defined
 
@@ -55,29 +55,29 @@ class IResource a where
         readResource :: a -> IO (Maybe a)
         readResource x = readResourceByKey $ keyResource x
 
-        -- | To write into persistent storage. It must be strict.  
+        -- | To write into persistent storage. It must be strict.
         -- Since STM transactions may retry, @writeResource@ must be idempotent, not only in the result but also in the effect in the database.
         -- . However, because it is executed by 'safeIOToSTM' it is guaranteed that the execution is not interrupted.
         -- All the new obbects are writeen to the database on synchromization,
         -- so writeResource must not autocommit.
         -- Commit code must be located in the postcondition. (see  `setConditions`)
         -- Since there is no provision for rollback from failure in writing to
         -- persistent storage, 'writeResource' must retry until success.
-    	writeResource:: a-> IO()
-    	writeResource r= writeResources [r]
-    	
-    	-- | multiple write (hopefully) in a single request. That is up to you and your backend
-    	-- . Defined by default as 'mapM_ writeResource'
-    	writeResources :: [a] -> IO()
-    	writeResources= mapM_ writeResource
-
-        -- | Delete the resource. It is called syncronously. So it must commit   
-    	delResource:: a-> IO()
-    	delResource x= delResources [x]
-    	
+        writeResource:: a-> IO()
+        writeResource r= writeResources [r]
+
+        -- | multiple write (hopefully) in a single request. That is up to you and your backend
+        -- . Defined by default as 'mapM_ writeResource'
+        writeResources :: [a] -> IO()
+        writeResources= mapM_ writeResource
+
+        -- | Delete the resource. It is called syncronously. So it must commit
+        delResource:: a-> IO()
+        delResource x= delResources [x]
+
         delResources :: [a] -> IO()
         delResources= mapM_ delResource
--- | Resources data definition used by 'withSTMResources'    
+-- | Resources data definition used by 'withSTMResources'
 data Resources a b
        = Retry             -- ^ forces a retry
        | Resources
@@ -145,26 +145,26 @@ defaultReadResource x= defaultReadResourceByKey $ key x
 defaultReadResourceByKey :: (Serializable a, Indexable a) =>  String-> IO (Maybe a)
 defaultReadResourceByKey k= iox
      where
-     iox = handle handler $ do   
-             s <-  readFileStrict  filename :: IO String 
+     iox = handle handler $ do
+             s <-  readFileStrict  filename :: IO String
              return $ Just (deserialize s )                                                         -- `debug` ("read "++ filename)
-     
+
      filename=  defPathIO iox  ++ k
 
      defPathIO :: (Serializable a, Indexable a)=> IO (Maybe a) -> String
      defPathIO iox= defPath x
        where
        Just x= unsafePerformIO $ (return $ Just undefined)  `asTypeOf`  iox
 
- 
+
      handler :: (Serializable a, Indexable a) =>   IOError ->  IO (Maybe a)
      handler  e
-      | isAlreadyInUseError e = defaultReadResourceByKey  k                         
+      | isAlreadyInUseError e = defaultReadResourceByKey  k
       | isDoesNotExistError e = return Nothing
       | otherwise= if ("invalid" `isInfixOf` ioeGetErrorString e)
          then
             error $ ( "readResource: " ++ show e) ++ " defPath and/or keyResource are not suitable for a file path"
-              
+
          else defaultReadResourceByKey  k
 
 
@@ -174,16 +174,16 @@ defaultWriteResource x= safeWrite filename (serialize x)   --  `debug` ("write "
   filename= defPath x ++ key x
 
 safeWrite filename str= handle  handler  $ writeFile filename str
-     where          
+     where
      handler  (e :: IOError)
-       | isDoesNotExistError e=do 
+       | isDoesNotExistError e=do
                   createDirectoryIfMissing True $ take (1+(last $ elemIndices '/' filename)) filename   --maybe the path does not exist
-                  safeWrite filename str               
+                  safeWrite filename str
 
        | otherwise =do
                 --phPutStrLn stderr $ "defaultWriteResource:  " ++ show e ++  " in file: " ++ filename ++ " retrying"
                 safeWrite filename str
-              
+
 defaultDelResource :: (Indexable a) => a -> IO()
 defaultDelResource x=  handle (handler filename) $ removeFile filename  --`debug` ("delete "++filename)
      where
@@ -194,7 +194,7 @@ defaultDelResource x=  handle (handler filename) $ removeFile filename  --`debug
        | isAlreadyInUseError e= do
             --hPutStrLn stderr $ "defaultDelResource: busy"  ++  " in file: " ++ filename ++ " retrying"
             threadDelay 1000000
-            defaultDelResource x   
+            defaultDelResource x
        | otherwise = do
            --hPutStrLn stderr $ "defaultDelResource:  " ++ show e ++  " in file: " ++ filename ++ " retrying"
            threadDelay 1000000
@@ -209,9 +209,9 @@ readFileStrict f = openFile f ReadMode >>= \ h -> readIt h `finally` hClose h
   readIt h= do
       s   <- hFileSize h
       let n= fromIntegral s
-      str <- replicateM n (hGetChar h) 
+      str <- replicateM n (hGetChar h)
       return str
-    
+
 
 newtype Transient a= Transient a
 

Data/TCache/IndexQuery.hs

@@ -71,7 +71,7 @@ fields in a registers are to be indexed, they must have different types.
 
 {-# LANGUAGE  DeriveDataTypeable, MultiParamTypeClasses
 , FunctionalDependencies, FlexibleInstances, UndecidableInstances
-, TypeSynonymInstances, IncoherentInstances, OverlappingInstances #-}
+, TypeSynonymInstances, IncoherentInstances #-}
 module Data.TCache.IndexQuery(
   index
 , (.==.)

TCache.cabal

@@ -78,7 +78,7 @@ library
 
     exposed: True
     buildable: True
-    extensions: OverlappingInstances UndecidableInstances
+    extensions: UndecidableInstances
                 ScopedTypeVariables DeriveDataTypeable
     hs-source-dirs: .
     other-modules:

buildDemos.sh

@@ -0,0 +1,16 @@
+#!/bin/bash
+
+# This is a crude way to build all the demo files placing them into the
+# demos/bin folder and removing the build artifacts afterwards
+
+rm -rf ./demos/.build
+rm -rf ./demos/bin/*
+
+for fullfile in ./demos/*.hs; do
+  filename=$(basename -- "$fullfile")
+  binname="${filename%.*}"
+  echo "$filename -> $binname"
+  stack exec ghc -- -outputdir demos/.build $fullfile -o demos/bin/$binname
+done
+
+rm -rf ./demos/.build