content: module Reanimate.Cache
    ( cacheFile -- :: FilePath -> (FilePath -> IO ()) -> IO FilePath
    , cacheMem
    , cacheDisk
    , cacheDiskSvg
    , cacheDiskKey
    , cacheDiskLines
    , encodeInt
    ) where
  
  import           Control.Exception   (evaluate)
  import           Control.Monad       (unless)
  import           Data.Bits           (Bits (shiftR))
  import           Data.Hashable       (Hashable (hash))
  import           Data.IORef          (IORef, atomicModifyIORef, newIORef, readIORef)
  import           Data.Map            (Map)
  import qualified Data.Map            as Map
  import           Data.Text           (Text)
  import qualified Data.Text           as T
  import qualified Data.Text.IO        as T
  import           Graphics.SvgTree    (Tree, pattern None, unparse)
  import           Reanimate.Animation (renderTree)
  import           Reanimate.Misc      (getReanimateCacheDirectory, renameOrCopyFile)
  import           System.Directory    (doesFileExist)
  import           System.FilePath     ((<.>), (</>))
  import           System.IO           (hClose)
  import           System.IO.Temp      (openTempFile, withSystemTempFile)
  import           System.IO.Unsafe    (unsafePerformIO)
  import           Text.XML.Light      (Content (..), parseXML)
  
  -- Memory cache and disk cache
  
  cacheFile :: FilePath -> (FilePath -> IO ()) -> IO FilePath
  cacheFile template gen = do
      root <- getReanimateCacheDirectory
      let path = root </> template
      hit <- doesFileExist path
      unless hit $ withSystemTempFile template $ \tmp h -> do
        hClose h
        gen tmp
        renameOrCopyFile tmp path
      evaluate path
  
  cacheDisk :: String -> (T.Text -> Maybe a) -> (a -> T.Text) -> (Text -> IO a) -> (Text -> IO a)
  cacheDisk cacheType parse render gen key = do
      root <- getReanimateCacheDirectory
      let path = root </> encodeInt (hash key) <.> cacheType
      hit <- doesFileExist path
      if hit
        then do
          inp <- T.readFile path
          case parse inp of
            Nothing  -> genCache root path
            Just val -> pure val
        else genCache root path
    where
      genCache root path = do
        (tmpPath, tmpHandle) <- openTempFile root (encodeInt (hash key))
        new <- gen key
        T.hPutStr tmpHandle (render new)
        hClose tmpHandle
        renameOrCopyFile tmpPath path
        return new
  
  cacheDiskKey :: Text -> IO Tree -> IO Tree
  cacheDiskKey key gen = cacheDiskSvg (const gen) key
  
  cacheDiskSvg :: (Text -> IO Tree) -> (Text -> IO Tree)
  cacheDiskSvg = cacheDisk "svg" parse render
    where
      parse txt = case parseXML txt of
        [Elem t] -> Just (unparse t)
        _        -> Nothing
      render = T.pack . renderTree
  
  cacheDiskLines :: (Text -> IO [Text]) -> (Text -> IO [Text])
  cacheDiskLines = cacheDisk "txt" parse render
    where
      parse = Just . T.lines
      render = T.unlines
  
  
  {-# NOINLINE cache #-}
  cache :: IORef (Map Text Tree)
  cache = unsafePerformIO (newIORef Map.empty)
  
  cacheMem :: (Text -> IO Tree) -> (Text -> IO Tree)
  cacheMem gen key = do
    store <- readIORef cache
    case Map.lookup key store of
      Just svg -> return svg
      Nothing -> do
        svg <- gen key
        case svg of
          -- None usually indicates that latex or another tool was misconfigured. In this case,
          -- don't store the result.
          None -> pure svg
          _    -> atomicModifyIORef cache (\m -> (Map.insert key svg m, svg))
  
  encodeInt :: Int -> String
  encodeInt i = worker (fromIntegral i) 60
    where
      worker :: Word -> Int -> String
      worker key sh
        | sh < 0 = []
        | otherwise =
          case (key `shiftR` sh) `mod` 32 of
            idx -> alphabet !! fromIntegral idx : worker key (sh-5)
      alphabet = "ABCDEFGHJKLMNPQRSTUVWXYZ23456789"
  