module HaskellWorks.Polysemy.Hedgehog.Workspace
  ( workspace
  , moduleWorkspace
  ) where

import           HaskellWorks.Polysemy.Hedgehog
import           HaskellWorks.Polysemy.Prelude
import           HaskellWorks.Polysemy.Stack
import           HaskellWorks.Polysemy.System.Directory
import           HaskellWorks.Polysemy.System.Environment
import           HaskellWorks.Polysemy.System.IO.Temp
import           Polysemy
import           Polysemy.Error
import           Polysemy.Log
import           System.Info

import qualified HaskellWorks.Polysemy.System.IO          as PIO

-- | Create a workspace directory which will exist for at least the duration of
-- the supplied block.
--
-- The directory will have the supplied prefix but contain a generated random
-- suffix to prevent interference between tests
--
-- The directory will be deleted if the block succeeds, but left behind if
-- the block fails.
workspace :: ()
  => Member Hedgehog r
  => Member Log r
  => Member (Embed IO) r
  => Member (Error IOException) r
  => HasCallStack
  => FilePath
  -> (FilePath -> Sem r ())
  -> Sem r ()
workspace :: forall (r :: EffectRow).
(Member Hedgehog r, Member Log r, Member (Embed IO) r,
 Member (Error IOException) r, HasCallStack) =>
FilePath -> (FilePath -> Sem r ()) -> Sem r ()
workspace FilePath
prefixPath FilePath -> Sem r ()
f = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
  FilePath
systemTemp <- Sem r FilePath
forall (r :: EffectRow).
(HasCallStack, Member (Embed IO) r) =>
Sem r FilePath
getCanonicalTemporaryDirectory
  Maybe FilePath
maybeKeepWorkspace <- FilePath -> Sem r (Maybe FilePath)
forall (r :: EffectRow).
(HasCallStack, Member (Embed IO) r) =>
FilePath -> Sem r (Maybe FilePath)
lookupEnv FilePath
"KEEP_WORKSPACE"
  FilePath
ws <- FilePath -> FilePath -> Sem r FilePath
forall (r :: EffectRow).
(HasCallStack, Member (Embed IO) r) =>
FilePath -> FilePath -> Sem r FilePath
createTempDirectory FilePath
systemTemp (FilePath -> Sem r FilePath) -> FilePath -> Sem r FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
prefixPath FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-test"
  FilePath -> Sem r ()
forall (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
FilePath -> Sem r ()
jot_ (FilePath -> Sem r ()) -> FilePath -> Sem r ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Workspace: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
ws
  FilePath -> FilePath -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
FilePath -> FilePath -> Sem r ()
PIO.writeFile (FilePath
ws FilePath -> FilePath -> FilePath
</> FilePath
"module") FilePath
HasCallStack => FilePath
callerModuleName
  FilePath -> Sem r ()
f FilePath
ws
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath
os FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"mingw32" Bool -> Bool -> Bool
&& Maybe FilePath
maybeKeepWorkspace Maybe FilePath -> Maybe FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"1") (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
FilePath -> Sem r ()
removePathForcibly FilePath
ws

-- | Create a workspace directory which will exist for at least the duration of
-- the supplied block.
--
-- The directory will have the prefix as "$prefixPath/$moduleName" but contain a generated random
-- suffix to prevent interference between tests
--
-- The directory will be deleted if the block succeeds, but left behind if
-- the block fails.
--
-- The 'prefix' argument should not contain directory delimeters.
moduleWorkspace ::  ()
  => Member Hedgehog r
  => Member Log r
  => Member (Embed IO) r
  => Member (Error IOException) r
  => String
  -> (FilePath -> Sem r ())
  -> Sem r ()
moduleWorkspace :: forall (r :: EffectRow).
(Member Hedgehog r, Member Log r, Member (Embed IO) r,
 Member (Error IOException) r) =>
FilePath -> (FilePath -> Sem r ()) -> Sem r ()
moduleWorkspace FilePath
prefix FilePath -> Sem r ()
f = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
  FilePath -> (FilePath -> Sem r ()) -> Sem r ()
forall (r :: EffectRow).
(Member Hedgehog r, Member Log r, Member (Embed IO) r,
 Member (Error IOException) r, HasCallStack) =>
FilePath -> (FilePath -> Sem r ()) -> Sem r ()
workspace (FilePath
prefix FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
HasCallStack => FilePath
callerModuleName) FilePath -> Sem r ()
f