module Sound.Jammit.Internal.TempIO
( TempIO
, runTempIO
, newTempFile
, ask
, liftIO
) where
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Reader (ReaderT (..), ask)
import Data.List (stripPrefix)
import System.Directory (copyFile, renameFile)
import System.FilePath (splitPath)
import System.IO (hClose)
import System.IO.Error (catchIOError)
import System.IO.Temp (openTempFile,
withSystemTempDirectory)
type TempIO = ReaderT FilePath IO
runTempIO :: FilePath -> TempIO FilePath -> IO ()
runTempIO fout act = withSystemTempDirectory "tempfile" $ \tmp -> do
res <- runReaderT act tmp
case stripPrefix (splitPath tmp) (splitPath res) of
Just f | ".." `notElem` f ->
catchIOError (renameFile res fout) $ \_ -> copyFile res fout
_ -> copyFile res fout
newTempFile :: String -> TempIO FilePath
newTempFile pat = do
tmp <- ask
(f, h) <- liftIO $ openTempFile tmp pat
liftIO $ hClose h
return f