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
$cshowsPrec :: Int -> AST -> ShowS
showsPrec :: Int -> AST -> ShowS
$cshow :: AST -> String
show :: AST -> String
$cshowList :: [AST] -> ShowS
showList :: [AST] -> ShowS
Show)

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

literal :: String -> (AST, String)
literal String
str =
    let (String
a, 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
== Char
'$') String
str in (String -> AST
Literal String
a, String
b)

variable :: String -> (AST, String)
variable (Char
'{':String
as) =
    let (String
a, 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
== Char
'}') String
as in (String -> AST
Variable String
a, ShowS
forall a. HasCallStack => [a] -> [a]
tail String
b)
variable String
as = 
    let (String
a, 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 (Char
'$':String
as) =
    let (AST
a, 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 String
as = 
    let (AST
a, 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 String
var) = String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" 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 String
str) = String -> IO String
forall a. a -> IO a
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 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AST -> IO String
interpolate [AST]
ast