{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module PFile.Env
( resolve
, description
, Options (..)
, Env (..)
) where
import Control.Monad.Trans.Maybe (MaybeT (..))
import PFile.Error (onIOError)
import PFile.Path ((<//>))
import qualified PFile.Path as Path
import Protolude
import System.Directory
( XdgDirectory (..)
, doesDirectoryExist
, getXdgDirectory
, makeAbsolute
)
import System.Environment (lookupEnv)
resolve :: MonadIO m => Options -> m Env
resolve :: forall (m :: * -> *). MonadIO m => Options -> m Env
resolve options :: Options
options@Options {Bool
verbose :: Bool
verbose :: Options -> Bool
verbose} = IO Env -> m Env
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
Maybe String
resolved <-
MaybeT IO String -> IO (Maybe String)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO String -> IO (Maybe String))
-> ([IO (Maybe String)] -> MaybeT IO String)
-> [IO (Maybe String)]
-> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MaybeT IO String] -> MaybeT IO String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([MaybeT IO String] -> MaybeT IO String)
-> ([IO (Maybe String)] -> [MaybeT IO String])
-> [IO (Maybe String)]
-> MaybeT IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO (Maybe String) -> MaybeT IO String)
-> [IO (Maybe String)] -> [MaybeT IO String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IO (Maybe String) -> MaybeT IO String
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ([IO (Maybe String)] -> IO (Maybe String))
-> [IO (Maybe String)] -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$
[ String -> IO (Maybe String)
lookupEnv String
"PFILE_DATA_HOME"
, String -> IO Bool
doesDirectoryExist String
".pfile" IO Bool -> IO Bool -> IO Bool
forall a. IO a -> IO a -> IO a
`onIOError` Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
IO Bool -> (Bool -> Maybe String) -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Maybe String -> Maybe String -> Bool -> Maybe String
forall a. a -> a -> Bool -> a
bool Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
".pfile")
]
Absolute
dataHomeDirPath <-
IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgData String
"pfile") String -> IO String
makeAbsolute Maybe String
resolved
IO String -> (String -> Absolute) -> IO Absolute
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> Absolute
Path.Absolute
Env -> IO Env
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Env
{ Absolute
dataHomeDirPath :: Absolute
dataHomeDirPath :: Absolute
dataHomeDirPath
, profilesHomeDirPath :: Absolute
profilesHomeDirPath = Absolute
dataHomeDirPath Absolute -> String -> Absolute
<//> String
"profiles"
, currentLinkPath :: Absolute
currentLinkPath = Absolute
dataHomeDirPath Absolute -> String -> Absolute
<//> String
"current"
, print :: Text -> IO ()
PFile.Env.print = (Text -> IO ()) -> (Text -> IO ()) -> Bool -> Text -> IO ()
forall a. a -> a -> Bool -> a
bool (IO () -> Text -> IO ()
forall a b. a -> b -> a
const (IO () -> Text -> IO ()) -> IO () -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrLn Bool
verbose
, Options
options :: Options
options :: Options
options
}
description :: Env -> Text
description :: Env -> Text
description Env {Absolute
dataHomeDirPath :: Env -> Absolute
dataHomeDirPath :: Absolute
dataHomeDirPath}
= Text
"PFile uses data home directory: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
Path.showAbsolute Absolute
dataHomeDirPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
newtype Options
= Options
{ Options -> Bool
verbose :: Bool
}
data Env
= Env
{ Env -> Absolute
dataHomeDirPath :: !Path.Absolute
, Env -> Absolute
profilesHomeDirPath :: !Path.Absolute
, Env -> Absolute
currentLinkPath :: !Path.Absolute
, Env -> Text -> IO ()
print :: !(Text -> IO ())
, Env -> Options
options :: !Options
}