-----------------------------------------------------------------------------
-- Copyright 2019, Advise-Me project team. This file is distributed under 
-- the terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-----------------------------------------------------------------------------

module Util.Cache 
   ( cached, cached2, cached3, cached4
   , printCache, writeCache
   ) where

import Control.Monad
import qualified Data.Map as M
import Data.IORef
import System.IO.Unsafe

cached :: (Ord a, Show a, Show b) => String -> (a -> b) -> a -> b
cached n = withCache . newCache n

cached2 :: (Ord a, Ord b, Show a, Show b, Show c) => String -> (a -> b -> c) -> a -> b -> c
cached2 s f = curry $ cached s $ uncurry $ f

cached3 :: (Ord a, Ord b, Ord c, Show a, Show b, Show c, Show d) => String -> (a -> b -> c -> d) -> a -> b -> c -> d
cached3 s f = curry3 $ cached s $ uncurry3 $ f
 where
   curry3 f a b c = f (a, b, c)
   uncurry3 f (a, b, c) = f a b c 

cached4 :: (Ord a, Ord b, Ord c, Ord d, Show a, Show b, Show c, Show d, Show e) => String -> (a -> b -> c -> d -> e) -> a -> b -> c -> d -> e
cached4 s f = curry4 $ cached s $ uncurry4 $ f
 where
   curry4 f a b c d = f (a, b, c, d)
   uncurry4 f (a, b, c, d) = f a b c d

data Cache a b = Cache 
   { name      :: String
   , function  :: a -> b
   , showKey   :: a -> String
   , showValue :: b -> String
   , counter   :: IORef Int
   , cache     :: IORef (M.Map a b)
   }

newCache :: (Show a, Show b) => String -> (a -> b) -> Cache a b
newCache n f = unsafePerformIO $ do 
   r   <- newIORef M.empty
   cnt <- newIORef 0
   let c = Cache n f show show cnt r
   modifyIORef register (c:)
   return c

withCache :: Ord a => Cache a b -> a -> b
withCache c a = unsafePerformIO $ do
   modifyIORef (counter c) (+1)
   m <- readIORef (cache c)
   case M.lookup a m of
      Just b  -> return b
      Nothing -> do
         let b = function c a
         writeIORef (cache c) (M.insert a b m)
         return b
         
------------------------------------------------------------------------

register :: IORef [Cache a b]
register = unsafePerformIO (newIORef [])

printCache :: IO () 
printCache = showCache >>= putStrLn
  
writeCache :: FilePath -> IO () 
writeCache file = showCache >>= writeFile file

showCache :: IO String
showCache = do
   xs <- readIORef register 
   fmap unlines $ forM xs $ \c -> do 
      n <- readIORef (counter c)
      m <- readIORef (cache c)
      let sz   = M.size m
          line = replicate 50 '-'
          f (a, b) = showKey c a ++ ": " ++ showValue c b
          summary = name c ++ ": size=" ++ show sz ++ 
                    ", access=" ++ show n ++ 
                    ", efficiency=" ++ showRatio (n-sz) n
      
      return $ unlines $ summary : line : map f (M.toList m)

showRatio :: Int -> Int -> String
showRatio a b = show rd
 where
   r  = (fromIntegral a / fromIntegral b) :: Double
   rn = round (r*1000) :: Int
   rd = (fromIntegral rn/1000) :: Double
   
{-
--  example:
fib :: Int -> Int
fib = cached "fib" $ \n -> 
   if n == 0 then 0
   else if n == 1 then 1 
   else fib (n-1) + fib (n-2)

main :: IO ()
main = do
   print (fib 50)
   printCache
-}