{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}

-- | "Development.GitRev.Internal.Environment" for 'OsString'.
--
-- @since 0.1
module Development.GitRev.Internal.Environment.OsString
  ( EnvError (..),
    envValQ,
    runInEnvDirQ,
    withEnvValQ,
  )
where

import Control.Exception (Exception (displayException))
import Control.Monad (join)
import Development.GitRev.Internal.Git.Common qualified as GitC
import Development.GitRev.Internal.OsString qualified as OsStringI
import Language.Haskell.TH (Q, runIO)
import Language.Haskell.TH.Syntax (Lift)
import System.Directory.OsPath qualified as Dir
import System.OsString (OsString, osstr)
#if MIN_VERSION_process(1, 6, 26)
import System.Process.Environment.OsString qualified as Process
#else
import System.Environment qualified as Env
#endif

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

-- | Performs an environment variable lookup in 'Q'.
--
-- ==== __Examples__
--
-- >>> setEnv "SOME_VAR" "val"
-- >>> $$(qToCode $ envValQ [osstr|SOME_VAR|])
-- Right "val"
--
-- @since 0.1
envValQ ::
  -- | The environment variable @k@.
  OsString ->
  -- | The result @v@ or an error.
  Q (Either EnvError OsString)
envValQ :: OsString -> Q (Either EnvError OsString)
envValQ OsString
var = OsString
-> (OsString -> Q OsString) -> Q (Either EnvError OsString)
forall a. OsString -> (OsString -> Q a) -> Q (Either EnvError a)
withEnvValQ OsString
var OsString -> Q OsString
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.OsPath (listDirectory)
-- >>> setEnv "SOME_DIR" "./src"
-- >>> $$(qToCode $ runInEnvDirQ [osstr|SOME_DIR|] $ runIO (listDirectory [osp|./|]))
-- Right ["Development"]
--
-- @since 0.1
runInEnvDirQ ::
  forall a.
  -- | The environment variable @k@ that should point to some directory
  -- @d@.
  OsString ->
  -- | The 'Q' action @q@.
  Q a ->
  -- | The result of running @q@ in directory @d@.
  Q (Either EnvError a)
runInEnvDirQ :: forall a. OsString -> Q a -> Q (Either EnvError a)
runInEnvDirQ OsString
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
$ OsString
-> (OsString -> Q (Either EnvError a))
-> Q (Either EnvError (Either EnvError a))
forall a. OsString -> (OsString -> Q a) -> Q (Either EnvError a)
withEnvValQ OsString
var ((OsString -> Q (Either EnvError a))
 -> Q (Either EnvError (Either EnvError a)))
-> (OsString -> Q (Either EnvError a))
-> Q (Either EnvError (Either EnvError a))
forall a b. (a -> b) -> a -> b
$ \OsString
repoDir -> do
  -- Try to change directory
  eCurrDir <- IO (Either SomeException OsString)
-> Q (Either SomeException OsString)
forall a. IO a -> Q a
runIO (IO (Either SomeException OsString)
 -> Q (Either SomeException OsString))
-> IO (Either SomeException OsString)
-> Q (Either SomeException OsString)
forall a b. (a -> b) -> a -> b
$ IO OsString -> IO (Either SomeException OsString)
forall a. IO a -> IO (Either SomeException a)
GitC.trySync (IO OsString -> IO (Either SomeException OsString))
-> IO OsString -> IO (Either SomeException OsString)
forall a b. (a -> b) -> a -> b
$ do
    currDir <- IO OsString
Dir.getCurrentDirectory
    Dir.setCurrentDirectory repoDir
    pure currDir

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

  case eCurrDir of
    Left SomeException
ex -> do
      let rsn :: OsString
rsn =
            [osstr|Could not set directory: |]
              OsString -> OsString -> OsString
forall a. Semigroup a => a -> a -> a
<> FilePath -> OsString
OsStringI.encodeLenient (SomeException -> FilePath
forall e. Exception e => e -> FilePath
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
$ OsString -> Either EnvError a
mkErr OsString
rsn
    Right OsString
currDir -> do
      r <- Q a
m
      eResult <- runIO $ GitC.trySync $ Dir.setCurrentDirectory currDir
      case eResult of
        Left SomeException
ex -> do
          let rsn :: OsString
rsn =
                [osstr|Could not restore directory: |]
                  OsString -> OsString -> OsString
forall a. Semigroup a => a -> a -> a
<> FilePath -> OsString
OsStringI.encodeLenient (SomeException -> FilePath
forall e. Exception e => e -> FilePath
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
$ OsString -> Either EnvError a
mkErr OsString
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 -> OsString
var :: OsString,
    -- | The value of the environment variable, if it exists.
    --
    -- @since 0.1
    EnvError -> Maybe OsString
value :: Maybe OsString,
    -- | Text reason for the failure.
    --
    -- @since 0.1
    EnvError -> OsString
reason :: OsString
  }
  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 -> ShowS
[EnvError] -> ShowS
EnvError -> FilePath
(Int -> EnvError -> ShowS)
-> (EnvError -> FilePath) -> ([EnvError] -> ShowS) -> Show EnvError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvError -> ShowS
showsPrec :: Int -> EnvError -> ShowS
$cshow :: EnvError -> FilePath
show :: EnvError -> FilePath
$cshowList :: [EnvError] -> ShowS
showList :: [EnvError] -> ShowS
Show
    )

-- | @since 0.1
instance Exception EnvError where
  displayException :: EnvError -> FilePath
displayException EnvError
err =
    [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath
"Environment error with env variable '",
        OsString -> FilePath
OsStringI.decodeLenient (OsString -> FilePath) -> OsString -> FilePath
forall a b. (a -> b) -> a -> b
$ EnvError -> OsString
var EnvError
err,
        FilePath
"', value ",
        OsString -> FilePath
OsStringI.decodeLenient OsString
valStr,
        FilePath
": ",
        OsString -> FilePath
OsStringI.decodeLenient (OsString -> FilePath) -> OsString -> FilePath
forall a b. (a -> b) -> a -> b
$ EnvError -> OsString
reason EnvError
err
      ]
    where
      valStr :: OsString
valStr = case EnvError -> Maybe OsString
value EnvError
err of
        Maybe OsString
Nothing -> [osstr|<none>|]
        Just OsString
value -> [osstr|'|] OsString -> OsString -> OsString
forall a. Semigroup a => a -> a -> a
<> OsString
value OsString -> OsString -> OsString
forall a. Semigroup a => a -> a -> a
<> [osstr|'|]

-- | Runs a 'Q'-action on the result of an environment variable, if it exists.
--
-- ==== __Examples__
--
-- >>> import System.Directory.OsPath (listDirectory)
-- >>> setEnv "SOME_DIR" "./src"
-- >>> $$(qToCode $ withEnvValQ [osstr|SOME_DIR|] (runIO . listDirectory))
-- Right ["Development"]
--
-- @since 0.1
withEnvValQ ::
  forall a.
  -- | The environment variable @k@ to lookup.
  OsString ->
  -- | Function to run on @k@'s /value/ if @k@ exists.
  (OsString -> Q a) ->
  Q (Either EnvError a)
withEnvValQ :: forall a. OsString -> (OsString -> Q a) -> Q (Either EnvError a)
withEnvValQ OsString
var OsString -> Q a
onEnv = do
  OsString -> Q (Maybe OsString)
lookupEnvQ OsString
var Q (Maybe OsString)
-> (Maybe OsString -> 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 OsString
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
$ OsString -> Maybe OsString -> OsString -> EnvError
MkEnvError OsString
var Maybe OsString
forall a. Maybe a
Nothing [osstr|No such var found.|]
    Just OsString
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
<$> OsString -> Q a
onEnv OsString
result

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

lookupEnv :: OsString -> IO (Maybe OsString)
#if MIN_VERSION_process(1, 6, 26)
lookupEnv = Process.getEnv
#else
lookupEnv :: OsString -> IO (Maybe OsString)
lookupEnv OsString
os = do
  fp <- OsString -> IO FilePath
forall (m :: * -> *). MonadThrow m => OsString -> m FilePath
OsStringI.decodeThrowM OsString
os
  r <- Env.lookupEnv fp
  traverse OsStringI.encodeThrowM r
#endif