module Data.IResource where

import System.Directory
import Control.Exception as Exception
import System.IO.Error
import Data.List(elemIndices)
import System.IO
import Control.Monad(when,replicateM)


--import Debug.Trace

--debug a b= trace b a

{- | A general interface for indexable, serializable  and input-output objects.
 'readResource' and 'writeResource' are implemented by default as read-write to files with its key as filename
 'serialize' and 'deserialize' are specified just to allow these defaults. If you define your own persistence, then
 @serialize@ and @deserialize@ are not needed. The package 'Workflow' need them anyway.

minimal definition: keyResource, serialize, deserialize

While serialize and deserialize are agnostic about the way of converison to strings, either binary or textual, treadp and
tshowp use the monad defined in the RefSerialize package. Both ways of serialization are alternative. one is defined
by default in terms of the other. the RefSerialize monad has been introduced to permit IResource objects to be
serialized as part of larger structures that embody them. This is necessary for the Workdlow package.

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 have the fields used by keyResource filled. For example

 @  readResource Person {name="John", surname= "Adams"}@

leaving the rest of the fields undefined
 
-}

-- | IResource has defaults definitions for all the methods except keyResource
-- Either one or other serializer must be defiened for default witeResource, readResource and delResource
class IResource a where

        keyResource :: a -> String             -- ^ must be defined

        serialize :: a -> String                   -- ^  must be defined by the user


        deserialize :: String -> a               -- ^  must be defined by the user
           
        defPath :: a-> String       -- ^ additional extension for default file paths or key prefixes 
        defPath _ = "" 

	-- get object content from the file 
	-- (NOTE: reads and writes can't collide, so they-- Not really needed since no write is done while read
	-- must be strict, not lazy )
	readResource :: a-> IO (Maybe a)
        readResource x=handleJust (\e -> fromException e) handleIt $ do     
             s <- readFileStrict  filename  :: IO String 
             return $ Just $ deserialize s                                                            -- `debug` ("read "++ filename)
             where
             filename=  defPath x++ keyResource x
             --handleIt :: IResource a => IOError -> IO (Maybe a)
             handleIt  e
              |isAlreadyInUseError e = readResource x    -- maybe is being written. try again. 
                                                         
              | isDoesNotExistError e = return Nothing
              | isPermissionError e = error $ "readResource: no permissions for opening file: "++filename
              | otherwise= error $ "readResource: " ++ show e

	writeResource:: a-> IO()
        writeResource x=handleJust (\e -> fromException e)  (handleIt x) $ writeFile filename (serialize x)   --  `debug` ("write "++filename)
             where
             filename= defPath x ++ keyResource x
             --handleIt :: a -> IOError -> IO ()
             handleIt x e
               | isDoesNotExistError e=do 
                          createDirectoryIfMissing True $ take (1+(last $ elemIndices '/' filename)) filename   --maybe the path does not exist
                          writeResource x                
--               | isAlreadyInUseError e= writeResource x -- maybe is being read. try again
                                                           -- Not really needed since no write is done while read

               | otherwise =do
                        hPutStrLn stderr $ "writeResource:  " ++ show e ++  " in file: " ++ filename ++ " retrying"
                        writeResource  x
 {-
                               | isAlreadyExistsError   e =
                                              do
                                                   hPutStrLn stderr $ "writeResource: already exist file: " ++ filename ++ " retrying"
                                                   writeResource  x



                               |   isAlreadyInUseError e =
                                              do
                                                   hPutStrLn stderr $ "writeResource: already in use: " ++ filename ++ " retrying"
                                                   writeResource  x
                               |   isFullError   e =
                                              do
                                                   hPutStrLn stderr $ "writeResource: file full: " ++ filename ++ " retrying"
                                                   writeResource  x
                               |   isEOFError  e =
                                              do
                                                   hPutStrLn stderr $ "writeResource: EOF in file: " ++ filename ++ " retrying"
                                                   writeResource  x
                               |   isIllegalOperation   e=
                                              do
                                                   hPutStrLn stderr $ "writeResource: illegal Operation in file: " ++ filename ++ " retrying"
                                                   writeResource  x
                               |   isPermissionError  e  =
                                              do
                                                   hPutStrLn stderr $ "writeResource:permission error in file: " ++ filename ++ " retrying"
                                                   writeResource  x
                               |   isUserError   e  =
                                              do
                                                   hPutStrLn stderr $ "writeResource:user error in file: " ++ filename ++ " retrying"
                                                   writeResource  x


                               | otherwise =do
                                                    hPutStrLn stderr $ "writeResource:   error  " ++ show e ++  " in file: " ++ filename 
                                                    writeResource  x
-}
               
	delResource:: a-> IO()
	delResource x= handleJust (\e -> fromException e)  (handleIt filename) $ removeFile filename  --`debug` ("delete "++filename)
	
             where
             filename= defPath x ++ keyResource x
             handleIt :: String -> IOError -> IO ()
             handleIt file e
               | isDoesNotExistError e= return ()
               | isAlreadyInUseError e= delResource x
               | isPermissionError e=    delResource x
   
               | otherwise = error ("delResource: " ++ show e ++ "for the file: "++ filename)


	
type AccessTime = Integer
type ModifTime    = Integer


infinite=10000000000

-- | Resources returned by 'withSTMResources''     
data Resources a b
                   = Retry             -- ^ forces a retry
                   | Resources
                      { toAdd :: [a]    -- ^ resources to be inserted back in the cache
                      , toDelete :: [a] -- ^ resources to be deleted from the cache and from permanent storage
                      , toReturn :: b   -- ^ result to be returned
                      }


-- |  @resources= Resources  [] [] ()@
resources :: Resources a ()
resources= Resources  [] [] ()



-- Strict file read, needed for the default file persistence
readFileStrict f = openFile f ReadMode >>= \ h -> readIt h `finally` hClose h
  where
  readIt h= do
      s   <- hFileSize h
      let n= fromIntegral s
      str <- replicateM n (hGetChar h) 
      return str