-----------------------------------------------------------------------------
-- |
-- Module      :  XMobar.Environment
-- Copyright   :  (c) William Song
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Will Song <incertia@incertia.net>
-- Stability   :  stable
-- Portability :  portable
--
-- A function to expand environment variables in strings
--
-----------------------------------------------------------------------------
module Xmobar.System.Environment(expandEnv) where

import qualified Data.Maybe as M
import qualified System.Environment as E

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

  Char
'\\' -> case [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"" of
    Bool
True  -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"\\"
    Bool
False -> do
      [Char]
remainder <- [Char] -> IO [Char]
expandEnv forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 [Char]
s
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
escString [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
remainder
      where escString :: [Char] -> [Char]
escString [Char]
s' = let (Char
cc:[Char]
_) = [Char]
s' in
              case Char
cc of
                Char
't' -> [Char]
"\t"
                Char
'n' -> [Char]
"\n"
                Char
'$' -> [Char]
"$"
                Char
_   -> [Char
cc]

  Char
_    -> do
    [Char]
remainder <- [Char] -> IO [Char]
expandEnv [Char]
s
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char
c forall a. a -> [a] -> [a]
: [Char]
remainder