module Reanimate.Morph.Cache
  ( cachePointCorrespondence -- :: Int -> PointCorrespondence -> PointCorrespondence
  ) where

import           Control.Exception
import qualified Data.ByteString        as B
import           Data.Hashable
import           Data.Serialize
import           Reanimate.Cache        (encodeInt)
import           Reanimate.Misc         (renameOrCopyFile,getReanimateCacheDirectory)
import           Reanimate.Morph.Common
import           System.Directory
import           System.FilePath
import           System.IO
import           System.IO.Temp
import           System.IO.Unsafe

-- type PointCorrespondence = Polygon → Polygon → (Polygon, Polygon)
cachePointCorrespondence :: Int -> PointCorrespondence -> PointCorrespondence
cachePointCorrespondence :: Int -> PointCorrespondence -> PointCorrespondence
cachePointCorrespondence Int
ident PointCorrespondence
fn Polygon
src Polygon
dst = IO (Polygon, Polygon) -> (Polygon, Polygon)
forall a. IO a -> a
unsafePerformIO (IO (Polygon, Polygon) -> (Polygon, Polygon))
-> IO (Polygon, Polygon) -> (Polygon, Polygon)
forall a b. (a -> b) -> a -> b
$ do
    FilePath
root <- IO FilePath
getReanimateCacheDirectory
    let path :: FilePath
path = FilePath
root FilePath -> FilePath -> FilePath
</> FilePath
template
    Bool
hit <- FilePath -> IO Bool
doesFileExist FilePath
path
    if Bool
hit
      then do
        ByteString
inp <- FilePath -> IO ByteString
B.readFile FilePath
path
        case ByteString -> Either FilePath (Polygon, Polygon)
forall a. Serialize a => ByteString -> Either FilePath a
decode ByteString
inp of
          Left{} -> do
            FilePath -> IO ()
removeFile FilePath
path
            FilePath -> IO (Polygon, Polygon)
gen FilePath
path
          Right (Polygon, Polygon)
out -> (Polygon, Polygon) -> IO (Polygon, Polygon)
forall (m :: * -> *) a. Monad m => a -> m a
return (Polygon, Polygon)
out
      else FilePath -> IO (Polygon, Polygon)
gen FilePath
path
  where
    gen :: FilePath -> IO (Polygon, Polygon)
gen FilePath
path = do
      (Polygon, Polygon)
correspondence <- (Polygon, Polygon) -> IO (Polygon, Polygon)
forall a. a -> IO a
evaluate (PointCorrespondence
fn Polygon
src Polygon
dst)
      FilePath -> (FilePath -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
withSystemTempFile FilePath
template ((FilePath -> Handle -> IO ()) -> IO ())
-> (FilePath -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
tmp Handle
h -> do
        Handle -> IO ()
hClose Handle
h
        FilePath -> ByteString -> IO ()
B.writeFile FilePath
tmp ((Polygon, Polygon) -> ByteString
forall a. Serialize a => a -> ByteString
encode (Polygon, Polygon)
correspondence)
        FilePath -> FilePath -> IO ()
renameOrCopyFile FilePath
tmp FilePath
path
      (Polygon, Polygon) -> IO (Polygon, Polygon)
forall (m :: * -> *) a. Monad m => a -> m a
return (Polygon, Polygon)
correspondence
    template :: FilePath
template = Int -> FilePath
encodeInt Int
key FilePath -> FilePath -> FilePath
<.> FilePath
"morph"
    key :: Int
key = Int -> (Polygon, Polygon) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
ident (Polygon
src,Polygon
dst)