module Xmobar.System.Environment(expandEnv) where
import Data.Maybe (fromMaybe)
import System.Environment (lookupEnv)
expandEnv :: String -> IO String
expandEnv :: String -> IO String
expandEnv String
"" = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
expandEnv (Char
c:String
s) = case Char
c of
Char
'$' -> do
String
envVar <- String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
e
String
remainder <- String -> IO String
expandEnv String
s'
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
envVar String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
remainder
where (String
e, String
s') = String -> (String, String)
getVar String
s
getVar :: String -> (String, String)
getVar String
"" = (String
"", String
"")
getVar (Char
'{':String
s'') = (String -> String -> String
forall (t :: * -> *) a. (Foldable t, Eq a) => t a -> [a] -> [a]
takeUntil String
"}" String
s'', Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall (t :: * -> *) a. (Foldable t, Eq a) => t a -> [a] -> [a]
dropUntil String
"}" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
s'')
getVar String
s'' = (String -> String -> String
forall (t :: * -> *) a. (Foldable t, Eq a) => t a -> [a] -> [a]
takeUntil String
filterstr String
s'', String -> String -> String
forall (t :: * -> *) a. (Foldable t, Eq a) => t a -> [a] -> [a]
dropUntil String
filterstr String
s'')
filterstr :: String
filterstr = String
",./? \t;:\"'~`!@#$%^&*()<>-+=\\|"
takeUntil :: t a -> [a] -> [a]
takeUntil t a
f = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> t a -> Bool) -> t a -> a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem t a
f)
dropUntil :: t a -> [a] -> [a]
dropUntil t a
f = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> t a -> Bool) -> t a -> a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem t a
f)
Char
'\\' -> case String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" of
Bool
True -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"\\"
Bool
False -> do
String
remainder <- String -> IO String
expandEnv (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
s
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String
escString String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
remainder
where escString :: String -> String
escString String
s' = let (Char
cc:String
_) = String
s' in
case Char
cc of
Char
't' -> String
"\t"
Char
'n' -> String
"\n"
Char
'$' -> String
"$"
Char
_ -> [Char
cc]
Char
_ -> do
String
remainder <- String -> IO String
expandEnv String
s
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
remainder