{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances, UndecidableInstances,
  MultiParamTypeClasses, ExistentialQuantification,
  ScopedTypeVariables #-}

{- | This module decouples the 'IResource" class in two classes
 one for key extraction 'Indexable' and other ('Serializable" for serlalization and persistence
 .The last one defines persistence in files as default, but it can be changed
 to persistence in databases, for example.

 The definitions of these classes are  in Defs.hs
-}
module Data.TCache.DefaultPersistence(
Indexable(..)
,Serializable(..)
,setDefaultPersist
,getDefaultPersist
,filePersist
,Persist(..)) where

import Data.Typeable
import Data.TCache.Defs
import Data.TCache

instance  (Typeable a,  Indexable a, Serializable a) => IResource a where
  keyResource :: a -> String
keyResource = forall a. Indexable a => a -> String
key
  writeResource :: a -> IO ()
writeResource = forall a. (Indexable a, Serializable a, Typeable a) => a -> IO ()
defWriteResource
  readResourceByKey :: String -> IO (Maybe a)
readResourceByKey = forall a.
(Indexable a, Serializable a, Typeable a) =>
String -> IO (Maybe a)
defReadResourceByKey
  delResource :: a -> IO ()
delResource = forall a. (Indexable a, Serializable a, Typeable a) => a -> IO ()
defDelResource

-- | By default the  index of a `Serializable` data persist with the data.
instance Serializable a => PersistIndex a where
   persistIndex :: a -> Maybe Persist
persistIndex= forall a. Serializable a => a -> Maybe Persist
setPersist