{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}

-- | A checked version of @System.Environment@
module CheckedIO.Environment (
  -- * getEnv
  GetEnvVarError (..),
  getEnvIO,
  getEnv,
  getEnvUIO,

  -- * lookupEnv
  lookupEnvIO,
  lookupEnv,
  lookupEnvUIO,
) where

-- import Data.ByteString (ByteString)
import Foreign.C.Types (CChar)
import Foreign.Ptr (Ptr, nullPtr)

import CheckedIO
import CheckedIO.Foreign (
  CString (..),
  EncodingError,
  fromCString,
  withCString,
 )

{----- getEnv -----}

data GetEnvVarError
  = GetEnvVarMissing String
  | GetEnvVarEncodingError EncodingError
  deriving (Int -> GetEnvVarError -> ShowS
[GetEnvVarError] -> ShowS
GetEnvVarError -> String
(Int -> GetEnvVarError -> ShowS)
-> (GetEnvVarError -> String)
-> ([GetEnvVarError] -> ShowS)
-> Show GetEnvVarError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetEnvVarError -> ShowS
showsPrec :: Int -> GetEnvVarError -> ShowS
$cshow :: GetEnvVarError -> String
show :: GetEnvVarError -> String
$cshowList :: [GetEnvVarError] -> ShowS
showList :: [GetEnvVarError] -> ShowS
Show, GetEnvVarError -> GetEnvVarError -> Bool
(GetEnvVarError -> GetEnvVarError -> Bool)
-> (GetEnvVarError -> GetEnvVarError -> Bool) -> Eq GetEnvVarError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetEnvVarError -> GetEnvVarError -> Bool
== :: GetEnvVarError -> GetEnvVarError -> Bool
$c/= :: GetEnvVarError -> GetEnvVarError -> Bool
/= :: GetEnvVarError -> GetEnvVarError -> Bool
Eq)

instance Exception GetEnvVarError where
  displayException :: GetEnvVarError -> String
displayException = \case
    GetEnvVarMissing String
name -> String
"getEnv: environment variable does not exist: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
    GetEnvVarEncodingError EncodingError
e -> String
"getEnv: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ EncodingError -> String
forall e. Exception e => e -> String
displayException EncodingError
e

getEnvIO :: MonadRunIO m => String -> m String
getEnvIO :: forall (m :: * -> *). MonadRunIO m => String -> m String
getEnvIO = UIO (Either GetEnvVarError String) -> m String
forall e (m :: * -> *) a.
(Exception e, MonadRunIO m) =>
UIO (Either e a) -> m a
uioToIO (UIO (Either GetEnvVarError String) -> m String)
-> (String -> UIO (Either GetEnvVarError String))
-> String
-> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UIO (Either GetEnvVarError String)
forall e (m :: * -> *).
MonadRunIOE e m =>
String -> m (Either GetEnvVarError String)
getEnvUIO

getEnv :: MonadRunIOE GetEnvVarError m => String -> m String
getEnv :: forall (m :: * -> *).
MonadRunIOE GetEnvVarError m =>
String -> m String
getEnv = UIO (Either GetEnvVarError String) -> m String
forall e (m :: * -> *) a.
MonadRunIOE e m =>
UIO (Either e a) -> m a
fromUIO (UIO (Either GetEnvVarError String) -> m String)
-> (String -> UIO (Either GetEnvVarError String))
-> String
-> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UIO (Either GetEnvVarError String)
forall e (m :: * -> *).
MonadRunIOE e m =>
String -> m (Either GetEnvVarError String)
getEnvUIO

getEnvUIO :: MonadRunIOE e m => String -> m (Either GetEnvVarError String)
getEnvUIO :: forall e (m :: * -> *).
MonadRunIOE e m =>
String -> m (Either GetEnvVarError String)
getEnvUIO String
name = Either EncodingError (Maybe String) -> Either GetEnvVarError String
forall {b}.
Either EncodingError (Maybe b) -> Either GetEnvVarError b
go (Either EncodingError (Maybe String)
 -> Either GetEnvVarError String)
-> m (Either EncodingError (Maybe String))
-> m (Either GetEnvVarError String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m (Either EncodingError (Maybe String))
forall e (m :: * -> *).
MonadRunIOE e m =>
String -> m (Either EncodingError (Maybe String))
lookupEnvUIO String
name
  where
    go :: Either EncodingError (Maybe b) -> Either GetEnvVarError b
go = \case
      Right (Just b
res) -> b -> Either GetEnvVarError b
forall a b. b -> Either a b
Right b
res
      Right Maybe b
Nothing -> GetEnvVarError -> Either GetEnvVarError b
forall a b. a -> Either a b
Left (String -> GetEnvVarError
GetEnvVarMissing String
name)
      Left EncodingError
e -> GetEnvVarError -> Either GetEnvVarError b
forall a b. a -> Either a b
Left (EncodingError -> GetEnvVarError
GetEnvVarEncodingError EncodingError
e)

{----- lookupEnv -----}

-- | Same as 'lookupEnv', except in 'IO'.
lookupEnvIO :: MonadRunIO m => String -> m (Maybe String)
lookupEnvIO :: forall (m :: * -> *). MonadRunIO m => String -> m (Maybe String)
lookupEnvIO = UIO (Either EncodingError (Maybe String)) -> m (Maybe String)
forall e (m :: * -> *) a.
(Exception e, MonadRunIO m) =>
UIO (Either e a) -> m a
uioToIO (UIO (Either EncodingError (Maybe String)) -> m (Maybe String))
-> (String -> UIO (Either EncodingError (Maybe String)))
-> String
-> m (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UIO (Either EncodingError (Maybe String))
forall e (m :: * -> *).
MonadRunIOE e m =>
String -> m (Either EncodingError (Maybe String))
lookupEnvUIO

-- | Same as 'lookupEnvUIO', except throwing the 'EncodingError'.
lookupEnv :: MonadRunIOE EncodingError m => String -> m (Maybe String)
lookupEnv :: forall (m :: * -> *).
MonadRunIOE EncodingError m =>
String -> m (Maybe String)
lookupEnv = UIO (Either EncodingError (Maybe String)) -> m (Maybe String)
forall e (m :: * -> *) a.
MonadRunIOE e m =>
UIO (Either e a) -> m a
fromUIO (UIO (Either EncodingError (Maybe String)) -> m (Maybe String))
-> (String -> UIO (Either EncodingError (Maybe String)))
-> String
-> m (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UIO (Either EncodingError (Maybe String))
forall e (m :: * -> *).
MonadRunIOE e m =>
String -> m (Either EncodingError (Maybe String))
lookupEnvUIO

-- | Look up the given environment variable.
lookupEnvUIO :: MonadRunIOE e m => String -> m (Either EncodingError (Maybe String))
lookupEnvUIO :: forall e (m :: * -> *).
MonadRunIOE e m =>
String -> m (Either EncodingError (Maybe String))
lookupEnvUIO String
name =
  (Either EncodingError (Either EncodingError (Maybe String))
 -> Either EncodingError (Maybe String))
-> m (Either EncodingError (Either EncodingError (Maybe String)))
-> m (Either EncodingError (Maybe String))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((EncodingError -> Either EncodingError (Maybe String))
-> (Either EncodingError (Maybe String)
    -> Either EncodingError (Maybe String))
-> Either EncodingError (Either EncodingError (Maybe String))
-> Either EncodingError (Maybe String)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either EncodingError -> Either EncodingError (Maybe String)
forall a b. a -> Either a b
Left Either EncodingError (Maybe String)
-> Either EncodingError (Maybe String)
forall a. a -> a
id) (m (Either EncodingError (Either EncodingError (Maybe String)))
 -> m (Either EncodingError (Maybe String)))
-> (IOE
      e (Either EncodingError (Either EncodingError (Maybe String)))
    -> m (Either EncodingError (Either EncodingError (Maybe String))))
-> IOE
     e (Either EncodingError (Either EncodingError (Maybe String)))
-> m (Either EncodingError (Maybe String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOE e (Either EncodingError (Either EncodingError (Maybe String)))
-> m (Either EncodingError (Either EncodingError (Maybe String)))
forall a. IOE e a -> m a
forall e (m :: * -> *) a. MonadRunIOE e m => IOE e a -> m a
runIOE (IOE e (Either EncodingError (Either EncodingError (Maybe String)))
 -> m (Either EncodingError (Maybe String)))
-> IOE
     e (Either EncodingError (Either EncodingError (Maybe String)))
-> m (Either EncodingError (Maybe String))
forall a b. (a -> b) -> a -> b
$
    String
-> (forall {s}.
    CString s -> IOE e (Either EncodingError (Maybe String)))
-> IOE
     e (Either EncodingError (Either EncodingError (Maybe String)))
forall e (m :: * -> *) a.
MonadRunAsIOE e m =>
String
-> (forall s. CString s -> m a) -> m (Either EncodingError a)
withCString String
name ((forall {s}.
  CString s -> IOE e (Either EncodingError (Maybe String)))
 -> IOE
      e (Either EncodingError (Either EncodingError (Maybe String))))
-> (forall {s}.
    CString s -> IOE e (Either EncodingError (Maybe String)))
-> IOE
     e (Either EncodingError (Either EncodingError (Maybe String)))
forall a b. (a -> b) -> a -> b
$ \(CString Ptr CChar
name') -> do
      Ptr CChar
res <- UIO (Ptr CChar) -> IOE e (Ptr CChar)
forall e (m :: * -> *) a. MonadRunIOE e m => UIO a -> m a
runUIO (UIO (Ptr CChar) -> IOE e (Ptr CChar))
-> UIO (Ptr CChar) -> IOE e (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> UIO (Ptr CChar)
c_getenv Ptr CChar
name'
      if Ptr CChar
res Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
        then Either EncodingError (Maybe String)
-> IOE e (Either EncodingError (Maybe String))
forall a. a -> IOE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either EncodingError (Maybe String)
 -> IOE e (Either EncodingError (Maybe String)))
-> Either EncodingError (Maybe String)
-> IOE e (Either EncodingError (Maybe String))
forall a b. (a -> b) -> a -> b
$ Maybe String -> Either EncodingError (Maybe String)
forall a b. b -> Either a b
Right Maybe String
forall a. Maybe a
Nothing
        else (String -> Maybe String)
-> Either EncodingError String
-> Either EncodingError (Maybe String)
forall a b.
(a -> b) -> Either EncodingError a -> Either EncodingError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe String
forall a. a -> Maybe a
Just (Either EncodingError String
 -> Either EncodingError (Maybe String))
-> IOE e (Either EncodingError String)
-> IOE e (Either EncodingError (Maybe String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString Any -> IOE e (Either EncodingError String)
forall e (m :: * -> *) s.
MonadRunIOE e m =>
CString s -> m (Either EncodingError String)
fromCString (Ptr CChar -> CString Any
forall s. Ptr CChar -> CString s
CString Ptr CChar
res)

-- TODO: add Windows support
foreign import ccall unsafe "getenv"
   c_getenv :: Ptr CChar -> UIO (Ptr CChar)