module XMonad.Wallpaper.Expand (expand) where

import Control.Monad.State
import Data.List
import Data.Char

import System.Posix.Env
import Data.Maybe
import Control.Applicative

data AST = Variable String | Literal String
    deriving (Int -> AST -> ShowS
[AST] -> ShowS
AST -> String
(Int -> AST -> ShowS)
-> (AST -> String) -> ([AST] -> ShowS) -> Show AST
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AST] -> ShowS
$cshowList :: [AST] -> ShowS
show :: AST -> String
$cshow :: AST -> String
showsPrec :: Int -> AST -> ShowS
$cshowsPrec :: Int -> AST -> ShowS
Show)

isExpr :: Char -> Bool
isExpr a :: Char
a = Char -> Bool
isAlphaNum Char
a Bool -> Bool -> Bool
|| Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_'

literal :: String -> (AST, String)
literal str :: String
str =
    let (a :: String
a, b :: String
b) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '$') String
str in (String -> AST
Literal String
a, String
b)

variable :: String -> (AST, String)
variable ('{':as :: String
as) =
    let (a :: String
a, b :: String
b) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '}') String
as in (String -> AST
Variable String
a, ShowS
forall a. [a] -> [a]
tail String
b)
variable as :: String
as = 
    let (a :: String
a, b :: String
b) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isExpr) String
as in (String -> AST
Variable String
a, String
b)

parse :: String -> [AST]
parse []       = []
parse ('$':as :: String
as) =
    let (a :: AST
a, b :: String
b) = String -> (AST, String)
variable String
as in AST
a AST -> [AST] -> [AST]
forall a. a -> [a] -> [a]
: String -> [AST]
parse String
b
parse as :: String
as = 
    let (a :: AST
a, b :: String
b) = String -> (AST, String)
literal String
as in AST
a AST -> [AST] -> [AST]
forall a. a -> [a] -> [a]
: String -> [AST]
parse String
b

interpolate :: AST -> IO String
interpolate (Variable var :: String
var) = String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ShowS
forall a. a -> a
id (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
getEnv String
var
interpolate (Literal str :: String
str) = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
str

expand :: String -> IO String
{- |
Expand string using environment variables, shell syntax are supported.
Examples:

>>> epxand "$HOME/Pictures"
"/home/user/Pictures"

>>> expand "${HOME}ABC"
"/home/userABC"
-}
expand :: String -> IO String
expand str :: String
str = do
    let ast :: [AST]
ast = String -> [AST]
parse String
str
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> IO [String] -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AST -> IO String) -> [AST] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AST -> IO String
interpolate [AST]
ast