-- | Provides utilities for querying environment variables.
--
-- @since 0.1
module Development.GitRev.Internal.Environment
  ( EnvError (..),
    envValQ,
    runInEnvDirQ,
    withEnvValQ,
  )
where

import Control.Exception (Exception (displayException))
import Control.Monad (join)
import Development.GitRev.Internal.Git.Common qualified as GitC
import Language.Haskell.TH (Q, runIO)
import Language.Haskell.TH.Syntax (Lift)
import System.Directory.OsPath qualified as Dir
import System.Environment qualified as Env
import System.OsPath qualified as OsPath

-- $setup
-- >>> import Development.GitRev.Typed (qToCode)
-- >>> import Language.Haskell.TH (Q, runIO, runQ)
-- >>> import System.Environment (setEnv)

-- | Performs an environment variable lookup in 'Q'.
--
-- ==== __Examples__
--
-- >>> setEnv "SOME_VAR" "val"
-- >>> $$(qToCode $ envValQ "SOME_VAR")
-- Right "val"
--
-- @since 0.1
envValQ ::
  -- | The environment variable @k@.
  String ->
  -- | The result @v@ or an error.
  Q (Either EnvError String)
envValQ :: String -> Q (Either EnvError String)
envValQ String
var = String -> (String -> Q String) -> Q (Either EnvError String)
forall a. String -> (String -> Q a) -> Q (Either EnvError a)
withEnvValQ String
var String -> Q String
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Runs the given 'Q'-action under the directory @d@ pointed to by the
-- given environment variable.
--
-- ==== __Examples__
--
-- >>> import System.Directory (listDirectory)
-- >>> setEnv "SOME_DIR" "./src"
-- >>> $$(qToCode $ runInEnvDirQ "SOME_DIR" $ runIO (listDirectory "./"))
-- Right ["Development"]
--
-- @since 0.1
runInEnvDirQ ::
  forall a.
  -- | The environment variable @k@ that should point to some directory
  -- @d@.
  String ->
  -- | The 'Q' action @q@.
  Q a ->
  -- | The result of running @q@ in directory @d@.
  Q (Either EnvError a)
runInEnvDirQ :: forall a. String -> Q a -> Q (Either EnvError a)
runInEnvDirQ String
var Q a
m = (Either EnvError (Either EnvError a) -> Either EnvError a)
-> Q (Either EnvError (Either EnvError a)) -> Q (Either EnvError a)
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either EnvError (Either EnvError a) -> Either EnvError a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Q (Either EnvError (Either EnvError a)) -> Q (Either EnvError a))
-> Q (Either EnvError (Either EnvError a)) -> Q (Either EnvError a)
forall a b. (a -> b) -> a -> b
$ String
-> (String -> Q (Either EnvError a))
-> Q (Either EnvError (Either EnvError a))
forall a. String -> (String -> Q a) -> Q (Either EnvError a)
withEnvValQ String
var ((String -> Q (Either EnvError a))
 -> Q (Either EnvError (Either EnvError a)))
-> (String -> Q (Either EnvError a))
-> Q (Either EnvError (Either EnvError a))
forall a b. (a -> b) -> a -> b
$ \String
repoDirFp -> do
  repoDirOs <- String -> Q OsPath
forall (m :: * -> *). MonadThrow m => String -> m OsPath
OsPath.encodeUtf String
repoDirFp

  -- Try to change directory
  eCurrDir <- runIO $ GitC.trySync $ do
    currDir <- Dir.getCurrentDirectory
    Dir.setCurrentDirectory repoDirOs
    pure currDir

  let mkErr = EnvError -> Either EnvError a
forall a b. a -> Either a b
Left (EnvError -> Either EnvError a)
-> (String -> EnvError) -> String -> Either EnvError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String -> EnvError
MkEnvError String
var (String -> Maybe String
forall a. a -> Maybe a
Just String
repoDirFp)

  case eCurrDir of
    Left SomeException
ex -> do
      let rsn :: String
rsn = String
"Could not set directory: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
ex
      Either EnvError a -> Q (Either EnvError a)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either EnvError a -> Q (Either EnvError a))
-> Either EnvError a -> Q (Either EnvError a)
forall a b. (a -> b) -> a -> b
$ String -> Either EnvError a
mkErr String
rsn
    Right OsPath
currDir -> do
      r <- Q a
m
      eResult <- runIO $ GitC.trySync $ Dir.setCurrentDirectory currDir
      case eResult of
        Left SomeException
ex -> do
          let rsn :: String
rsn = String
"Could not restore directory: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
ex
          Either EnvError a -> Q (Either EnvError a)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either EnvError a -> Q (Either EnvError a))
-> Either EnvError a -> Q (Either EnvError a)
forall a b. (a -> b) -> a -> b
$ String -> Either EnvError a
mkErr String
rsn
        Right ()
_ -> Either EnvError a -> Q (Either EnvError a)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either EnvError a -> Q (Either EnvError a))
-> Either EnvError a -> Q (Either EnvError a)
forall a b. (a -> b) -> a -> b
$ a -> Either EnvError a
forall a b. b -> Either a b
Right a
r

-- | Environment variable lookup failure.
--
-- @since 0.1
data EnvError = MkEnvError
  { -- | The environment variable.
    --
    -- @since 0.1
    EnvError -> String
var :: String,
    -- | The value of the environment variable, if it exists.
    --
    -- @since 0.1
    EnvError -> Maybe String
value :: Maybe String,
    -- | Text reason for the failure.
    --
    -- @since 0.1
    EnvError -> String
reason :: String
  }
  deriving stock
    ( -- | @since 0.1
      EnvError -> EnvError -> Bool
(EnvError -> EnvError -> Bool)
-> (EnvError -> EnvError -> Bool) -> Eq EnvError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnvError -> EnvError -> Bool
== :: EnvError -> EnvError -> Bool
$c/= :: EnvError -> EnvError -> Bool
/= :: EnvError -> EnvError -> Bool
Eq,
      -- | @since 0.1
      (forall (m :: * -> *). Quote m => EnvError -> m Exp)
-> (forall (m :: * -> *). Quote m => EnvError -> Code m EnvError)
-> Lift EnvError
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => EnvError -> m Exp
forall (m :: * -> *). Quote m => EnvError -> Code m EnvError
$clift :: forall (m :: * -> *). Quote m => EnvError -> m Exp
lift :: forall (m :: * -> *). Quote m => EnvError -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => EnvError -> Code m EnvError
liftTyped :: forall (m :: * -> *). Quote m => EnvError -> Code m EnvError
Lift,
      -- | @since 0.1
      Int -> EnvError -> String -> String
[EnvError] -> String -> String
EnvError -> String
(Int -> EnvError -> String -> String)
-> (EnvError -> String)
-> ([EnvError] -> String -> String)
-> Show EnvError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> EnvError -> String -> String
showsPrec :: Int -> EnvError -> String -> String
$cshow :: EnvError -> String
show :: EnvError -> String
$cshowList :: [EnvError] -> String -> String
showList :: [EnvError] -> String -> String
Show
    )

-- | @since 0.1
instance Exception EnvError where
  displayException :: EnvError -> String
displayException EnvError
err =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
      [ String
"Environment error with env variable '",
        EnvError -> String
var EnvError
err,
        String
"', value ",
        String
valStr,
        String
": ",
        EnvError -> String
reason EnvError
err
      ]
    where
      valStr :: String
valStr = case EnvError -> Maybe String
value EnvError
err of
        Maybe String
Nothing -> String
"<none>"
        Just String
value -> String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
value String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"

-- | Runs a 'Q'-action on the result of an environment variable, if it exists.
--
-- ==== __Examples__
--
-- >>> import System.Directory (listDirectory)
-- >>> setEnv "SOME_DIR" "./src"
-- >>> $$(qToCode $ withEnvValQ "SOME_DIR" (runIO . listDirectory))
-- Right ["Development"]
--
-- @since 0.1
withEnvValQ ::
  forall a.
  -- | The environment variable @k@ to lookup.
  String ->
  -- | Function to run on @k@'s /value/ if @k@ exists.
  (String -> Q a) ->
  Q (Either EnvError a)
withEnvValQ :: forall a. String -> (String -> Q a) -> Q (Either EnvError a)
withEnvValQ String
var String -> Q a
onEnv = do
  String -> Q (Maybe String)
lookupEnvQ String
var Q (Maybe String)
-> (Maybe String -> Q (Either EnvError a)) -> Q (Either EnvError a)
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe String
Nothing -> Either EnvError a -> Q (Either EnvError a)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either EnvError a -> Q (Either EnvError a))
-> Either EnvError a -> Q (Either EnvError a)
forall a b. (a -> b) -> a -> b
$ EnvError -> Either EnvError a
forall a b. a -> Either a b
Left (EnvError -> Either EnvError a) -> EnvError -> Either EnvError a
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String -> EnvError
MkEnvError String
var Maybe String
forall a. Maybe a
Nothing String
"No such var found."
    Just String
result -> a -> Either EnvError a
forall a b. b -> Either a b
Right (a -> Either EnvError a) -> Q a -> Q (Either EnvError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q a
onEnv String
result

lookupEnvQ :: String -> Q (Maybe String)
lookupEnvQ :: String -> Q (Maybe String)
lookupEnvQ = IO (Maybe String) -> Q (Maybe String)
forall a. IO a -> Q a
runIO (IO (Maybe String) -> Q (Maybe String))
-> (String -> IO (Maybe String)) -> String -> Q (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
Env.lookupEnv