module HaskellWorks.Polysemy.System.IO.Temp
  ( createTempDirectory,
    getCanonicalTemporaryDirectory,
  ) where

import           HaskellWorks.Polysemy.Prelude
import           Polysemy
import qualified System.IO.Temp                as IO

createTempDirectory :: ()
  => HasCallStack
  => Member (Embed IO) r
  => FilePath
  -> String
  -> Sem r FilePath
createTempDirectory :: forall (r :: EffectRow).
(HasCallStack, Member (Embed IO) r) =>
FilePath -> FilePath -> Sem r FilePath
createTempDirectory FilePath
fp FilePath
template = (HasCallStack => Sem r FilePath) -> Sem r FilePath
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r FilePath) -> Sem r FilePath)
-> (HasCallStack => Sem r FilePath) -> Sem r FilePath
forall a b. (a -> b) -> a -> b
$ do
  IO FilePath -> Sem r FilePath
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO FilePath -> Sem r FilePath) -> IO FilePath -> Sem r FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO FilePath
IO.createTempDirectory FilePath
fp FilePath
template
{-# INLINE createTempDirectory #-}

getCanonicalTemporaryDirectory :: ()
  => HasCallStack
  => Member (Embed IO) r
  => Sem r FilePath
getCanonicalTemporaryDirectory :: forall (r :: EffectRow).
(HasCallStack, Member (Embed IO) r) =>
Sem r FilePath
getCanonicalTemporaryDirectory = (HasCallStack => Sem r FilePath) -> Sem r FilePath
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r FilePath) -> Sem r FilePath)
-> (HasCallStack => Sem r FilePath) -> Sem r FilePath
forall a b. (a -> b) -> a -> b
$ do
  IO FilePath -> Sem r FilePath
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO FilePath
IO.getCanonicalTemporaryDirectory
{-# INLINE getCanonicalTemporaryDirectory #-}