{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE FlexibleContexts #-}

-- | Functions for retrieving context information from within tests.

module Test.Sandwich.Contexts where

import Control.Monad.Reader
import GHC.Stack
import Test.Sandwich.Types.ArgParsing
import Test.Sandwich.Types.RunTree
import Test.Sandwich.Types.Spec


-- | Get a context by its label.
getContext :: (Monad m, HasLabel context l a, HasCallStack, MonadReader context m) => Label l a -> m a
getContext :: Label l a -> m a
getContext = (context -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((context -> a) -> m a)
-> (Label l a -> context -> a) -> Label l a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label l a -> context -> a
forall context (l :: Symbol) a.
HasLabel context l a =>
Label l a -> context -> a
getLabelValue

-- | Get the root folder of the on-disk test tree for the current run.
-- Will be 'Nothing' if the run isn't configured to use the disk.
getRunRoot :: (Monad m, HasBaseContext context, MonadReader context m) => m (Maybe FilePath)
getRunRoot :: m (Maybe FilePath)
getRunRoot = (context -> Maybe FilePath) -> m (Maybe FilePath)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (BaseContext -> Maybe FilePath
baseContextRunRoot (BaseContext -> Maybe FilePath)
-> (context -> BaseContext) -> context -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. context -> BaseContext
forall a. HasBaseContext a => a -> BaseContext
getBaseContext)

-- | Get the on-disk folder corresponding to the current node.
-- Will be 'Nothing' if the run isn't configured to use the disk, or if the current node is configured
-- not to create a folder.
getCurrentFolder :: (HasBaseContext context, MonadReader context m, MonadIO m) => m (Maybe FilePath)
getCurrentFolder :: m (Maybe FilePath)
getCurrentFolder = (context -> Maybe FilePath) -> m (Maybe FilePath)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (BaseContext -> Maybe FilePath
baseContextPath (BaseContext -> Maybe FilePath)
-> (context -> BaseContext) -> context -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. context -> BaseContext
forall a. HasBaseContext a => a -> BaseContext
getBaseContext)

-- | Get the command line options, if configured.
-- Using the 'runSandwichWithCommandLineArgs' family of main functions will introduce these, or you can
-- introduce them manually
getCommandLineOptions :: (HasCommandLineOptions context a, MonadReader context m, MonadIO m) => m (CommandLineOptions a)
getCommandLineOptions :: m (CommandLineOptions a)
getCommandLineOptions = Label "commandLineOptions" (CommandLineOptions a)
-> m (CommandLineOptions a)
forall (m :: * -> *) context (l :: Symbol) a.
(Monad m, HasLabel context l a, HasCallStack,
 MonadReader context m) =>
Label l a -> m a
getContext Label "commandLineOptions" (CommandLineOptions a)
forall a. Label "commandLineOptions" (CommandLineOptions a)
commandLineOptions