{-# LANGUAGE CPP #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Common functions
module Podenv.Prelude
  ( module Relude,
    foldM,
    lookup,
    getEnv,
    orDie,
    mayFail,

    -- * io
    readFileM,
    hPutStrLn,

    -- * base env

#if !MIN_VERSION_relude(1,0,0)
    getArgs,
    lookupEnv,
#endif
    getExecutablePath,

    -- * xdg
    getCacheDir,
    getConfigDir,
    getDataDir,

    -- * directory
    createDirectoryIfMissing,
    getCurrentDirectory,
    doesFileExist,
    doesPathExist,
    doesSymlinkExist,
    pathIsSymbolicLink,
    findExecutable,
    (</>),
    takeFileName,
    takeDirectory,
    hasTrailingPathSeparator,
    listDirectory,

    -- * posix
    UserID,
    getRealUserID,

    -- * lens
    Lens',
    (^.),
    (.~),
    (?~),
    (%~),
    setWhenNothing,
  )
where

import qualified Control.Exception
import Control.Monad (foldM)
import qualified Data.Text.IO
import Lens.Family (ASetter, set, (%~), (.~), (^.))
import Relude
import Relude.Extra.Lens (Lens')
import System.Directory
import System.Environment
import System.FilePath.Posix (hasTrailingPathSeparator, takeDirectory, takeFileName, (</>))
import System.IO (hPutStrLn)
import qualified System.Posix.Files
import System.Posix.Types (UserID)
import System.Posix.User (getRealUserID)

orDie :: Maybe a -> Text -> Either Text a
orDie :: Maybe a -> Text -> Either Text a
orDie (Just a
a) Text
_ = a -> Either Text a
forall a b. b -> Either a b
Right a
a
orDie Maybe a
Nothing Text
e = Text -> Either Text a
forall a b. a -> Either a b
Left Text
e

mayFail :: Either Text a -> IO a
mayFail :: Either Text a -> IO a
mayFail (Right a
a) = a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
mayFail (Left Text
msg) = Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
msg) IO () -> IO Any -> IO Any
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Any
forall (m :: * -> *) a. MonadIO m => m a
exitFailure IO Any -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"over"

(?~) :: ASetter s t a (Maybe b) -> b -> s -> t
ASetter s t a (Maybe b)
l ?~ :: ASetter s t a (Maybe b) -> b -> s -> t
?~ b
b = ASetter s t a (Maybe b) -> Maybe b -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s t a (Maybe b)
l (b -> Maybe b
forall a. a -> Maybe a
Just b
b)

setWhenNothing :: ASetter s t (Maybe b) (Maybe b) -> b -> s -> t
ASetter s t (Maybe b) (Maybe b)
l setWhenNothing :: ASetter s t (Maybe b) (Maybe b) -> b -> s -> t
`setWhenNothing` b
b = ASetter s t (Maybe b) (Maybe b)
l ASetter s t (Maybe b) (Maybe b) -> (Maybe b -> Maybe b) -> s -> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe b -> (b -> Maybe b) -> Maybe b -> Maybe b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b -> Maybe b
forall a. a -> Maybe a
Just b
b) b -> Maybe b
forall a. a -> Maybe a
Just

getCacheDir :: IO FilePath
getCacheDir :: IO String
getCacheDir = XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgCache String
"podenv"

getDataDir :: IO FilePath
getDataDir :: IO String
getDataDir = XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgData String
"podenv"

getConfigDir :: IO FilePath
getConfigDir :: IO String
getConfigDir = XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgConfig String
"podenv"

readFileM :: FilePath -> IO Text
readFileM :: String -> IO Text
readFileM String
fp' = do
  Bool
exist <- IO Bool -> IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
fp'
  if Bool
exist
    then IO Text -> IO Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> IO Text) -> IO Text -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
Data.Text.IO.readFile String
fp'
    else Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""

doesSymlinkExist :: FilePath -> IO Bool
doesSymlinkExist :: String -> IO Bool
doesSymlinkExist String
fp =
  (SomeException -> Bool)
-> (String -> Bool) -> Either SomeException String -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> SomeException -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True) (Either SomeException String -> Bool)
-> IO (Either SomeException String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either SomeException String)
checkFp
  where
    checkFp :: IO (Either Control.Exception.SomeException FilePath)
    checkFp :: IO (Either SomeException String)
checkFp = IO String -> IO (Either SomeException String)
forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try (IO String -> IO (Either SomeException String))
-> IO String -> IO (Either SomeException String)
forall a b. (a -> b) -> a -> b
$ String -> IO String
System.Posix.Files.readSymbolicLink String
fp