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

import Control.Exception
  ( Exception (displayException),
  )
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
-- >>> :set -XTemplateHaskell
-- >>> 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 LookupEnvError String)
envValQ :: String -> Q (Either LookupEnvError String)
envValQ String
var = String -> (String -> Q String) -> Q (Either LookupEnvError String)
forall a. String -> (String -> Q a) -> Q (Either LookupEnvError 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 LookupEnvError a)
runInEnvDirQ :: forall a. String -> Q a -> Q (Either LookupEnvError a)
runInEnvDirQ String
var Q a
m = String -> (String -> Q a) -> Q (Either LookupEnvError a)
forall a. String -> (String -> Q a) -> Q (Either LookupEnvError a)
withEnvValQ String
var ((String -> Q a) -> Q (Either LookupEnvError a))
-> (String -> Q a) -> Q (Either LookupEnvError 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
  currDir <- runIO Dir.getCurrentDirectory
  runIO $ Dir.setCurrentDirectory repoDirOs
  r <- m
  runIO $ Dir.setCurrentDirectory currDir
  pure $ r

-- | Environment variable lookup failure. The value is the variable we
-- attempted to look up.
--
-- @since 0.1
newtype LookupEnvError = MkLookupEnvError String
  deriving stock
    ( -- | @since 0.1
      LookupEnvError -> LookupEnvError -> Bool
(LookupEnvError -> LookupEnvError -> Bool)
-> (LookupEnvError -> LookupEnvError -> Bool) -> Eq LookupEnvError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LookupEnvError -> LookupEnvError -> Bool
== :: LookupEnvError -> LookupEnvError -> Bool
$c/= :: LookupEnvError -> LookupEnvError -> Bool
/= :: LookupEnvError -> LookupEnvError -> Bool
Eq,
      -- | @since 0.1
      (forall (m :: * -> *). Quote m => LookupEnvError -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    LookupEnvError -> Code m LookupEnvError)
-> Lift LookupEnvError
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => LookupEnvError -> m Exp
forall (m :: * -> *).
Quote m =>
LookupEnvError -> Code m LookupEnvError
$clift :: forall (m :: * -> *). Quote m => LookupEnvError -> m Exp
lift :: forall (m :: * -> *). Quote m => LookupEnvError -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
LookupEnvError -> Code m LookupEnvError
liftTyped :: forall (m :: * -> *).
Quote m =>
LookupEnvError -> Code m LookupEnvError
Lift,
      -- | @since 0.1
      Int -> LookupEnvError -> ShowS
[LookupEnvError] -> ShowS
LookupEnvError -> String
(Int -> LookupEnvError -> ShowS)
-> (LookupEnvError -> String)
-> ([LookupEnvError] -> ShowS)
-> Show LookupEnvError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LookupEnvError -> ShowS
showsPrec :: Int -> LookupEnvError -> ShowS
$cshow :: LookupEnvError -> String
show :: LookupEnvError -> String
$cshowList :: [LookupEnvError] -> ShowS
showList :: [LookupEnvError] -> ShowS
Show
    )

-- | @since 0.1
instance Exception LookupEnvError where
  displayException :: LookupEnvError -> String
displayException (MkLookupEnvError String
var) =
    String
"Failed to lookup environment variable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
var

-- | 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 LookupEnvError a)
withEnvValQ :: forall a. String -> (String -> Q a) -> Q (Either LookupEnvError a)
withEnvValQ String
var String -> Q a
onEnv = do
  String -> Q (Maybe String)
lookupEnvQ String
var Q (Maybe String)
-> (Maybe String -> Q (Either LookupEnvError a))
-> Q (Either LookupEnvError 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 LookupEnvError a -> Q (Either LookupEnvError a)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either LookupEnvError a -> Q (Either LookupEnvError a))
-> Either LookupEnvError a -> Q (Either LookupEnvError a)
forall a b. (a -> b) -> a -> b
$ LookupEnvError -> Either LookupEnvError a
forall a b. a -> Either a b
Left (LookupEnvError -> Either LookupEnvError a)
-> LookupEnvError -> Either LookupEnvError a
forall a b. (a -> b) -> a -> b
$ String -> LookupEnvError
MkLookupEnvError String
var
    Just String
result -> a -> Either LookupEnvError a
forall a b. b -> Either a b
Right (a -> Either LookupEnvError a)
-> Q a -> Q (Either LookupEnvError 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