module Text.Splice
    ( SpliceEnv
    , MissingEnvVar (..)
    , splice
    ) where

import           Control.Exception (Exception)
import qualified Data.List         as List
import           Data.Typeable     (Typeable)

-- | Environment for splicing in things.
type SpliceEnv = [(String, String)]

data MissingEnvVar = MissingEnvVar String
    deriving (Typeable)

instance Show MissingEnvVar where
    show :: MissingEnvVar -> String
show (MissingEnvVar String
k) = String
"Missing environment variable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
k

instance Exception MissingEnvVar

-- | Splice in a string with "Hello ${FOO}" syntax.
splice :: SpliceEnv -> String -> Either MissingEnvVar String
splice :: SpliceEnv -> String -> Either MissingEnvVar String
splice SpliceEnv
env = String -> Either MissingEnvVar String
go
  where
    go :: String -> Either MissingEnvVar String
go String
str = case (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 of
        -- Splice
        (String
xs, Char
'$' : Char
'{' : String
ys) -> case (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
ys of
            (String
key, Char
'}' : String
zs) -> case String -> SpliceEnv -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
key SpliceEnv
env of
                Maybe String
Nothing  -> MissingEnvVar -> Either MissingEnvVar String
forall a b. a -> Either a b
Left (MissingEnvVar -> Either MissingEnvVar String)
-> MissingEnvVar -> Either MissingEnvVar String
forall a b. (a -> b) -> a -> b
$ String -> MissingEnvVar
MissingEnvVar String
key
                Just String
val -> ShowS -> Either MissingEnvVar String -> Either MissingEnvVar String
forall a b.
(a -> b) -> Either MissingEnvVar a -> Either MissingEnvVar b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
val) String -> ShowS
forall a. [a] -> [a] -> [a]
++) (String -> Either MissingEnvVar String
go String
zs)
            (String
_, String
_) -> ShowS -> Either MissingEnvVar String -> Either MissingEnvVar String
forall a b.
(a -> b) -> Either MissingEnvVar a -> Either MissingEnvVar b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"${") String -> ShowS
forall a. [a] -> [a] -> [a]
++) (String -> Either MissingEnvVar String
go String
ys)
        -- Escape
        (String
xs, Char
'$' : Char
'$' : String
ys) ->
            let (String
dollars, String
zs) = (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
ys in
            if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$') String
dollars Bool -> Bool -> Bool
&& String
"{" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` String
zs
                then (String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
dollars String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"${" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> Either MissingEnvVar String -> Either MissingEnvVar String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either MissingEnvVar String
go (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
zs)
                else (String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"$$" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> Either MissingEnvVar String -> Either MissingEnvVar String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either MissingEnvVar String
go String
ys
        (String
xs, []) -> String -> Either MissingEnvVar String
forall a b. b -> Either a b
Right String
xs
        (String
xs, (Char
y : String
ys)) -> (String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
y Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> Either MissingEnvVar String -> Either MissingEnvVar String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Either MissingEnvVar String
go String
ys)