{-# LANGUAGE ExistentialQuantification, RankNTypes, Rank2Types, Safe #-}
module Text.Chatty.Expansion.Vars where
import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import System.Environment
import Text.Chatty.Expansion
data EnvVar = NotSet
| Literal String
| forall a.Show a => Scalar a
| Array [EnvVar]
instance Show EnvVar where
show :: EnvVar -> String
show (Scalar a
s) = a -> String
forall a. Show a => a -> String
show a
s
show (Literal String
s) = String
s
show (Array [EnvVar]
ps) = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (EnvVar -> String) -> [EnvVar] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map EnvVar -> String
forall a. Show a => a -> String
show [EnvVar]
ps
show EnvVar
NotSet = String
""
newtype ExpanderT m a = Expander {
ExpanderT m a -> [(String, EnvVar)] -> m (a, [(String, EnvVar)])
runExpanderT :: [(String,EnvVar)] -> m (a,[(String,EnvVar)])
}
instance Monad m => Monad (ExpanderT m) where
return :: a -> ExpanderT m a
return a
a = ([(String, EnvVar)] -> m (a, [(String, EnvVar)])) -> ExpanderT m a
forall (m :: * -> *) a.
([(String, EnvVar)] -> m (a, [(String, EnvVar)])) -> ExpanderT m a
Expander (([(String, EnvVar)] -> m (a, [(String, EnvVar)]))
-> ExpanderT m a)
-> ([(String, EnvVar)] -> m (a, [(String, EnvVar)]))
-> ExpanderT m a
forall a b. (a -> b) -> a -> b
$ \[(String, EnvVar)]
vs -> (a, [(String, EnvVar)]) -> m (a, [(String, EnvVar)])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,[(String, EnvVar)]
vs)
(Expander [(String, EnvVar)] -> m (a, [(String, EnvVar)])
e) >>= :: ExpanderT m a -> (a -> ExpanderT m b) -> ExpanderT m b
>>= a -> ExpanderT m b
f = ([(String, EnvVar)] -> m (b, [(String, EnvVar)])) -> ExpanderT m b
forall (m :: * -> *) a.
([(String, EnvVar)] -> m (a, [(String, EnvVar)])) -> ExpanderT m a
Expander (([(String, EnvVar)] -> m (b, [(String, EnvVar)]))
-> ExpanderT m b)
-> ([(String, EnvVar)] -> m (b, [(String, EnvVar)]))
-> ExpanderT m b
forall a b. (a -> b) -> a -> b
$ \[(String, EnvVar)]
vs -> do (a
a,[(String, EnvVar)]
vs') <- [(String, EnvVar)] -> m (a, [(String, EnvVar)])
e [(String, EnvVar)]
vs; ExpanderT m b -> [(String, EnvVar)] -> m (b, [(String, EnvVar)])
forall (m :: * -> *) a.
ExpanderT m a -> [(String, EnvVar)] -> m (a, [(String, EnvVar)])
runExpanderT (a -> ExpanderT m b
f a
a) [(String, EnvVar)]
vs'
instance MonadTrans ExpanderT where
lift :: m a -> ExpanderT m a
lift m a
m = ([(String, EnvVar)] -> m (a, [(String, EnvVar)])) -> ExpanderT m a
forall (m :: * -> *) a.
([(String, EnvVar)] -> m (a, [(String, EnvVar)])) -> ExpanderT m a
Expander (([(String, EnvVar)] -> m (a, [(String, EnvVar)]))
-> ExpanderT m a)
-> ([(String, EnvVar)] -> m (a, [(String, EnvVar)]))
-> ExpanderT m a
forall a b. (a -> b) -> a -> b
$ \[(String, EnvVar)]
vs -> do a
a <- m a
m; (a, [(String, EnvVar)]) -> m (a, [(String, EnvVar)])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,[(String, EnvVar)]
vs)
instance MonadIO m => MonadIO (ExpanderT m) where
liftIO :: IO a -> ExpanderT m a
liftIO = m a -> ExpanderT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ExpanderT m a) -> (IO a -> m a) -> IO a -> ExpanderT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance Monad m => Functor (ExpanderT m) where
fmap :: (a -> b) -> ExpanderT m a -> ExpanderT m b
fmap a -> b
f ExpanderT m a
a = ([(String, EnvVar)] -> m (b, [(String, EnvVar)])) -> ExpanderT m b
forall (m :: * -> *) a.
([(String, EnvVar)] -> m (a, [(String, EnvVar)])) -> ExpanderT m a
Expander (([(String, EnvVar)] -> m (b, [(String, EnvVar)]))
-> ExpanderT m b)
-> ([(String, EnvVar)] -> m (b, [(String, EnvVar)]))
-> ExpanderT m b
forall a b. (a -> b) -> a -> b
$ \[(String, EnvVar)]
vs -> do (a
a',[(String, EnvVar)]
vs') <- ExpanderT m a -> [(String, EnvVar)] -> m (a, [(String, EnvVar)])
forall (m :: * -> *) a.
ExpanderT m a -> [(String, EnvVar)] -> m (a, [(String, EnvVar)])
runExpanderT ExpanderT m a
a [(String, EnvVar)]
vs; (b, [(String, EnvVar)]) -> m (b, [(String, EnvVar)])
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
a',[(String, EnvVar)]
vs')
instance Monad m => Applicative (ExpanderT m) where
<*> :: ExpanderT m (a -> b) -> ExpanderT m a -> ExpanderT m b
(<*>) = ExpanderT m (a -> b) -> ExpanderT m a -> ExpanderT m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
pure :: a -> ExpanderT m a
pure = a -> ExpanderT m a
forall (m :: * -> *) a. Monad m => a -> m a
return
localEnvironment :: Functor m => ExpanderT m a -> m a
localEnvironment :: ExpanderT m a -> m a
localEnvironment ExpanderT m a
m = ((a, [(String, EnvVar)]) -> a) -> m (a, [(String, EnvVar)]) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, [(String, EnvVar)]) -> a
forall a b. (a, b) -> a
fst (m (a, [(String, EnvVar)]) -> m a)
-> m (a, [(String, EnvVar)]) -> m a
forall a b. (a -> b) -> a -> b
$ ExpanderT m a -> [(String, EnvVar)] -> m (a, [(String, EnvVar)])
forall (m :: * -> *) a.
ExpanderT m a -> [(String, EnvVar)] -> m (a, [(String, EnvVar)])
runExpanderT ExpanderT m a
m []
forkEnvironment :: (Functor m,Monad m,MonadIO m) => ExpanderT m a -> m a
forkEnvironment :: ExpanderT m a -> m a
forkEnvironment ExpanderT m a
m = do
[(String, String)]
es <- IO [(String, String)] -> m [(String, String)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(String, String)]
getEnvironment
((a, [(String, EnvVar)]) -> a) -> m (a, [(String, EnvVar)]) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, [(String, EnvVar)]) -> a
forall a b. (a, b) -> a
fst (m (a, [(String, EnvVar)]) -> m a)
-> m (a, [(String, EnvVar)]) -> m a
forall a b. (a -> b) -> a -> b
$ ExpanderT m a -> [(String, EnvVar)] -> m (a, [(String, EnvVar)])
forall (m :: * -> *) a.
ExpanderT m a -> [(String, EnvVar)] -> m (a, [(String, EnvVar)])
runExpanderT ExpanderT m a
m ([(String, EnvVar)] -> m (a, [(String, EnvVar)]))
-> [(String, EnvVar)] -> m (a, [(String, EnvVar)])
forall a b. (a -> b) -> a -> b
$ ((String, String) -> (String, EnvVar))
-> [(String, String)] -> [(String, EnvVar)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> EnvVar) -> (String, String) -> (String, EnvVar)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second String -> EnvVar
Literal) [(String, String)]
es
exportAll :: (Monad m,MonadIO m) => ExpanderT m ()
exportAll :: ExpanderT m ()
exportAll = ([(String, EnvVar)] -> m ((), [(String, EnvVar)]))
-> ExpanderT m ()
forall (m :: * -> *) a.
([(String, EnvVar)] -> m (a, [(String, EnvVar)])) -> ExpanderT m a
Expander (([(String, EnvVar)] -> m ((), [(String, EnvVar)]))
-> ExpanderT m ())
-> ([(String, EnvVar)] -> m ((), [(String, EnvVar)]))
-> ExpanderT m ()
forall a b. (a -> b) -> a -> b
$ \[(String, EnvVar)]
vs -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [(String, EnvVar)] -> ((String, EnvVar) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, EnvVar)]
vs (((String, EnvVar) -> IO ()) -> IO ())
-> ((String, EnvVar) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
k,EnvVar
v) -> String -> String -> IO ()
setEnv String
k (EnvVar -> String
forall a. Show a => a -> String
show EnvVar
v)
((), [(String, EnvVar)]) -> m ((), [(String, EnvVar)])
forall (m :: * -> *) a. Monad m => a -> m a
return ((),[(String, EnvVar)]
vs)
instance ChExpand IO where
expand :: String -> IO String
expand = String -> IO String
forall (m :: * -> *).
(Monad m, Functor m, ChExpanderEnv m) =>
String -> m String
expandVars
instance ChExpand m => ChExpand (ExpanderT m) where
expand :: String -> ExpanderT m String
expand = m String -> ExpanderT m String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m String -> ExpanderT m String)
-> (String -> m String) -> String -> ExpanderT m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m String
forall (e :: * -> *). ChExpand e => String -> e String
expand (String -> ExpanderT m String)
-> (String -> ExpanderT m String) -> String -> ExpanderT m String
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> ExpanderT m String
forall (m :: * -> *).
(Monad m, Functor m, ChExpanderEnv m) =>
String -> m String
expandVars
expandVars :: (Monad m,Functor m,ChExpanderEnv m) => String -> m String
expandVars :: String -> m String
expandVars [] = String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return []
expandVars (Char
'\\':Char
'$':String
ss) = do String
r <- String -> m String
forall (m :: * -> *).
(Monad m, Functor m, ChExpanderEnv m) =>
String -> m String
expandVars String
ss; String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'$'Char -> ShowS
forall a. a -> [a] -> [a]
:String
r)
expandVars (Char
'$':Char
'{':String
ss) =
let nm :: String
nm = Int -> ShowS
takeBrace Int
0 String
ss
rm :: String
rm = Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
nm Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
ss
takeBrace :: Int -> String -> String
takeBrace :: Int -> ShowS
takeBrace Int
0 (Char
'}':String
ss) = String
""
takeBrace Int
n (Char
'}':String
ss) = Char
'}' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> ShowS
takeBrace (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String
ss
takeBrace Int
n (Char
'{':String
ss) = Char
'{' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> ShowS
takeBrace (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
ss
takeBrace Int
n (Char
s:String
ss) = Char
s Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> ShowS
takeBrace Int
n String
ss
in do
String
v <- (EnvVar -> String) -> m EnvVar -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EnvVar -> String
forall a. Show a => a -> String
show (m EnvVar -> m String) -> m EnvVar -> m String
forall a b. (a -> b) -> a -> b
$ String -> m EnvVar
forall (ee :: * -> *). ChExpanderEnv ee => String -> ee EnvVar
mgetv String
nm
String
r <- String -> m String
forall (m :: * -> *).
(Monad m, Functor m, ChExpanderEnv m) =>
String -> m String
expandVars String
rm
String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
vString -> ShowS
forall a. [a] -> [a] -> [a]
++String
r)
expandVars (Char
'$':String
ss) =
let (String
nm,String
rm) = ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isAnum ShowS -> ShowS -> String -> (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isAnum) String
ss
in do
String
v <- (EnvVar -> String) -> m EnvVar -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EnvVar -> String
forall a. Show a => a -> String
show (m EnvVar -> m String) -> m EnvVar -> m String
forall a b. (a -> b) -> a -> b
$ String -> m EnvVar
forall (ee :: * -> *). ChExpanderEnv ee => String -> ee EnvVar
mgetv String
nm
String
r <- String -> m String
forall (m :: * -> *).
(Monad m, Functor m, ChExpanderEnv m) =>
String -> m String
expandVars String
rm
String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
vString -> ShowS
forall a. [a] -> [a] -> [a]
++String
r)
expandVars (Char
s:String
ss) = do String
ss' <- String -> m String
forall (m :: * -> *).
(Monad m, Functor m, ChExpanderEnv m) =>
String -> m String
expandVars String
ss; String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
sChar -> ShowS
forall a. a -> [a] -> [a]
:String
ss')
isAnum :: Char -> Bool
isAnum = (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char
'a'..Char
'z']String -> ShowS
forall a. [a] -> [a] -> [a]
++[Char
'A'..Char
'Z']String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"_"String -> ShowS
forall a. [a] -> [a] -> [a]
++[Char
'0'..Char
'9']))
class Monad ee => ChExpanderEnv ee where
mgetv :: String -> ee EnvVar
mputv :: String -> EnvVar -> ee ()
instance Monad m => ChExpanderEnv (ExpanderT m) where
mgetv :: String -> ExpanderT m EnvVar
mgetv String
s = ([(String, EnvVar)] -> m (EnvVar, [(String, EnvVar)]))
-> ExpanderT m EnvVar
forall (m :: * -> *) a.
([(String, EnvVar)] -> m (a, [(String, EnvVar)])) -> ExpanderT m a
Expander (([(String, EnvVar)] -> m (EnvVar, [(String, EnvVar)]))
-> ExpanderT m EnvVar)
-> ([(String, EnvVar)] -> m (EnvVar, [(String, EnvVar)]))
-> ExpanderT m EnvVar
forall a b. (a -> b) -> a -> b
$ \[(String, EnvVar)]
vs -> (EnvVar, [(String, EnvVar)]) -> m (EnvVar, [(String, EnvVar)])
forall (m :: * -> *) a. Monad m => a -> m a
return ((EnvVar, [(String, EnvVar)]) -> m (EnvVar, [(String, EnvVar)]))
-> (EnvVar, [(String, EnvVar)]) -> m (EnvVar, [(String, EnvVar)])
forall a b. (a -> b) -> a -> b
$
case ((String, EnvVar) -> Bool)
-> [(String, EnvVar)] -> [(String, EnvVar)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
s)(String -> Bool)
-> ((String, EnvVar) -> String) -> (String, EnvVar) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String, EnvVar) -> String
forall a b. (a, b) -> a
fst) [(String, EnvVar)]
vs of
[] -> (EnvVar
NotSet,[(String, EnvVar)]
vs)
((String
_,EnvVar
v):[(String, EnvVar)]
_) -> (EnvVar
v,[(String, EnvVar)]
vs)
mputv :: String -> EnvVar -> ExpanderT m ()
mputv String
k EnvVar
v = ([(String, EnvVar)] -> m ((), [(String, EnvVar)]))
-> ExpanderT m ()
forall (m :: * -> *) a.
([(String, EnvVar)] -> m (a, [(String, EnvVar)])) -> ExpanderT m a
Expander (([(String, EnvVar)] -> m ((), [(String, EnvVar)]))
-> ExpanderT m ())
-> ([(String, EnvVar)] -> m ((), [(String, EnvVar)]))
-> ExpanderT m ()
forall a b. (a -> b) -> a -> b
$ \[(String, EnvVar)]
vs -> ((), [(String, EnvVar)]) -> m ((), [(String, EnvVar)])
forall (m :: * -> *) a. Monad m => a -> m a
return ((),(String
k,EnvVar
v)(String, EnvVar) -> [(String, EnvVar)] -> [(String, EnvVar)]
forall a. a -> [a] -> [a]
:((String, EnvVar) -> Bool)
-> [(String, EnvVar)] -> [(String, EnvVar)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
k)(String -> Bool)
-> ((String, EnvVar) -> String) -> (String, EnvVar) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String, EnvVar) -> String
forall a b. (a, b) -> a
fst) [(String, EnvVar)]
vs)
instance ChExpanderEnv IO where
mgetv :: String -> IO EnvVar
mgetv = (String -> EnvVar) -> IO String -> IO EnvVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> EnvVar
Literal (IO String -> IO EnvVar)
-> (String -> IO String) -> String -> IO EnvVar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
getEnv
mputv :: String -> EnvVar -> IO ()
mputv String
k EnvVar
v = String -> String -> IO ()
setEnv String
k (EnvVar -> String
forall a. Show a => a -> String
show EnvVar
v)