TCache-0.13.3: demos/basicSample.hs

{-# LANGUAGE  DeriveDataTypeable #-}
module Main where


import Data.TCache
import Data.TCache.DefaultPersistence
import Data.ByteString.Lazy.Char8(pack,unpack)
import Control.Concurrent
import Data.Foldable (for_)
import Data.Typeable
import Debug.Trace

debug :: a -> String -> a
debug a b= trace b a

-- The data elements to be used in the example: A user will repeatedly buy Items.

data  Data=   User{uname::String, uid::String, spent:: Int} |
              Item{iname::String, iid::String, price::Int, stock::Int}

              deriving (Read, Show, Typeable)


-- defining prototypes to make missing-fields warning useful again
user_ :: Data
user_ = User{uname = undefined, uid = undefined, spent = undefined }

item_ :: Data
item_ = Item{iname = undefined, iid = undefined, price = undefined, stock = undefined }

-- The mappings between the cache and the physical storage are defined by the interface IResource
--      to extract the unique key,
--      to serializa to string
--      to deserialize from string
--      key prefix (or , if use "/", directory where to store the resource if default write is to be used)
--      to read the resource from the physical storage, (optional, default in files)
--      to store it  (optional, default from file)
--      to delete the resource from the physical storage. (optional. Default provided)



instance Indexable Data where
  key   User { uid=id' } = id'
  key   Item { iid=id' } = id'

instance Serializable Data where
  serialize = pack . show
  deserialize = read . unpack



-- buy is the operation to be performed in the example

-- withResources gets a partial definition of each resource necessary for extracting the key,
-- fill all the rest of the data structures (if found ) and return a list of Maybe Data.

-- buyIt is part of the domain problem. it receive this list and generates a new list of
-- data objects that are updated in the cache. buyIt is executed atomically.


buy :: Data -> Data -> IO ()
user `buy` item =  withResources [user, item] buyIt
 where
    buyIt[Just us, Just it]
       | stock it > 0 = [us',it'] `debug` ("john spent " ++ show (spent us) ++
          " so far. Hey tries to buy a PC from the stock of " ++ show (stock it))
       | otherwise   = error "stock is empty for this product"

      where
       us'= us{ spent = spent us + price it}
       it'= it{ stock = stock it - 1 }

    buyIt _ = error "either the user or the item does not exist"


main :: IO ()
main = do
  -- create resources (access no resources and return two new Data objects defined in items)
  withResources [] prepareItems

  -- 11 PCs are charged to the John´s account in parallel, to show transactionality
  -- because there are only 10 PCs in stock, the last thread must return an error
  for_ [(1::Int)..11] $ const $ forkIO $ user_{ uid = "U12345" } `buy` item_{ iid = "I54321" }

  -- wait a second (to let the forked io finish)
  threadDelay 1000000

  -- get the contents of the resources by their keys
  [us,it] <-  getResources [user_{ uid = "U12345" }, item_{ iid = "I54321" }]

  putStrLn $  "user data=" ++ show us
  putStrLn $  "item data=" ++ show it

  -- write the cache content in a persistent store (invoke writeResource for each resource)
  -- in a real application clearSyncCacheProc can be used instead to adjust size and write the cache periodically
  syncCache
  threadDelay 1000000

  -- the files U12345 and I54321 in .tcachedata must now contain the result of the 11 iterations

  where
    prepareItems = const
      [ User "John" "U12345" 0
      , Item "PC" "I54321" 6000 10
      ]