{-# LANGUAGE ExistentialQuantification, RankNTypes, Rank2Types, Safe #-}

{-
  This module is part of Chatty.
  Copyleft (c) 2014 Marvin Cohrs

  All wrongs reversed. Sharing is an act of love, not crime.
  Please share Antisplice with everyone you like.

  Chatty is free software: you can redistribute it and/or modify
  it under the terms of the GNU Affero General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  Chatty is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  GNU Affero General Public License for more details.

  You should have received a copy of the GNU Affero General Public License
  along with Chatty. If not, see <http://www.gnu.org/licenses/>.
-}

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 --hiding (getEnv)
--import System.Posix.Env (getEnv, setEnv)
import Text.Chatty.Expansion

-- | Some environment variable
data EnvVar = NotSet                       -- ^ Not set.
            | Literal String               -- ^ An embeddable string.
            | forall a.Show a => Scalar a  -- ^ Something we can show.
            | Array [EnvVar]               -- ^ Array of that

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
""


-- | Environment storage and variable expander.
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

-- | Run this function inside a blank environment.
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 []

-- | Run this function in a locally modifiable, but not exported environment
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

-- | Export this local environment.
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

-- | Expand $variables
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')

-- | Is alphanumeric?
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']))

-- | Typeclass for all environment storages.
class Monad ee => ChExpanderEnv ee where
  -- | Get environment variable
  mgetv :: String -> ee EnvVar
  -- | Put environment variable
  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)