Add pre_if directive to mimic the if directive in nginx

I'm unsure what to do with the parenthesis removal thing. Right now
it's... broken.

2 files changed, 88 insertions, 4 deletions

diff --git a/Main.hs b/Main.hs
index 43f698c..d3eff20 100644
--- a/Main.hs
+++ b/Main.hs
@@ -76,8 +76,8 @@ parser = between ws eof $ many stmt
     -- directive.  (Which means that "${v}" and "$v" are not equivalent if the
     -- directive does not resolve variables, which means our parse/format
     -- round-trip is buggy)
-    str = between (char '"' ) (char '"' ) (qstr (/='"' ))
-      <|> between (char '\'') (char '\'') (qstr (/='\''))
+    str = between (char '"' ) (char '"' ) (qstr (/='"' ) <|> return [Literal ""])
+      <|> between (char '\'') (char '\'') (qstr (/='\'') <|> return [Literal ""])
       <|> qstr (\c -> not (isSpace c) && c /= '{' && c /= ';')
 
     qstr f = some (
@@ -161,6 +161,10 @@ data Error
   | IncludeParse (ParseError (Token String) Void)
   | IncludeRecurse
   | SetArg
+  | IfNeedsBlock
+  | IfUnknown
+  | IfInvalidArg
+  | IfUnresolvedVar String
 
 instance Show Error where
   show MacroNoName = "Macro directive missing or invalid name argument, syntax is \"macro name ..args.. { }\""
@@ -179,6 +183,10 @@ instance Show Error where
   show (IncludeParse e) = parseErrorPretty e
   show IncludeRecurse = "Recursion depth exceeded with 'pre_include'"
   show SetArg = "Invalid argument(s) to 'pre_set'"
+  show IfNeedsBlock = "'pre_if' directive requires a block argument"
+  show IfUnknown = "Unknown argument or operator in 'pre_if' directive"
+  show IfInvalidArg = "Invalid &block or @array argument to 'pre_if'"
+  show (IfUnresolvedVar n) = "Unresolved variable '$"++n++"' in 'pre_if'"
 
 instance Exception Error
 
@@ -237,6 +245,76 @@ macroExpand m iargs iblock = do
 
 
 
+-- [Arg] should not have been interpolated yet, otherwise rmParen may remove
+-- parenthesis from variables.
+ifExpand :: PState -> [Arg] -> Conf -> IO Conf
+ifExpand st arg conf = do
+  -- Turn Arg into [ArgComponent] and remove parenthesis
+  args <- filter (not.null) . fmap (filter isNonEmpty) . rmParen <$> mapM validateArg arg
+  ok <- case args of
+
+    -- Single argument, test if true/false
+    [v] -> do
+      v' <- interpArg v
+      return $ v' /= "" && v' /= "0"
+
+    -- Equality/inequality
+    [a, [Literal "=" ], b] -> (==) <$> interpArg a <*> interpArg b
+    [a, [Literal "!="], b] -> (/=) <$> interpArg a <*> interpArg b
+
+    -- Dunno
+    _ -> throwIO IfUnknown
+
+  return $ if ok then conf else []
+
+  where
+  -- All arguments must be fully evaluated ArgStrings
+  validateArg :: Arg -> IO [ArgComponent]
+  validateArg (ArgString l) = return l
+  validateArg _             = throwIO IfInvalidArg
+
+  -- Performs variable substitution and flattens the result
+  interpArg :: [ArgComponent] -> IO String
+  interpArg a = do
+    [ArgString a'] <- procArg st [ArgString a]
+    join <$> mapM flat a'
+    where
+    flat (Literal n) = return n
+    flat (Variable n) = throwIO (IfUnresolvedVar n)
+
+  -- nginx allows parenthesis around the if arguments. It doesn't really fit
+  -- the way the config file is parsed, but let's emulate it anyway.
+  -- This function may result in empty string literals, which should be
+  -- filtered out separately. (And this code is horrible)
+  --
+  -- This solution is a bit quircky with quoted arguments:
+  --   if "($something)"    -> if $something
+  --   if "($some" thing)   -> if $some thing
+  --   if (some "thing)"    -> if some thing
+  --   if (something) ""    -> exception
+  --   if ""                -> considered the same as having no arguments
+  --   if $var = ""         -> unknown operator (ugh this is bad)
+  rmParen :: [[ArgComponent]] -> [[ArgComponent]]
+  rmParen args = case args of
+    -- (something)  - Single, literal argument
+    [[Literal ('(':xs)]]  -> if not (null xs) && last xs == ')' then [[Literal (init xs)]] else args
+    -- ($something) - Single, multi-component argument
+    [Literal ('(':xs):cs] -> case last cs of
+      Literal ls -> if last ls == ')' then [Literal xs : init cs ++ [Literal (init ls)]] else args
+      _          -> args
+    -- (some thing) - Multiple arguments
+    (Literal ('(':xs):cs):as -> case last (last as) of
+      Literal ls -> if last ls == ')' then [Literal xs : cs] ++ init as ++ [init (last as) ++ [Literal (init ls)]] else args
+      _          -> args
+    -- anything else
+    _ -> args
+
+  isNonEmpty (Literal "") = False
+  isNonEmpty _ = True
+
+
+
+
 data PState = PState
   { stVars     :: HashMap String [ArgComponent]
   , stMacros   :: HashMap String Macro
@@ -307,6 +385,11 @@ procConf gst gconf = foldM p (gst, []) gconf
         return (st { stVars = M.insert n arg' (stVars st) }, [])
       _ -> throwIO SetArg
 
+  stmt st (Directive "pre_if" a b) =
+    (st,) <$> case b of
+      Nothing -> throwIO IfNeedsBlock
+      Just b' -> procConf' st b' >>= ifExpand st a
+
   stmt st (Directive name a b) = (st,) <$> do
     a' <- procArg st a
     b' <- mapM (procConf' st) b
diff --git a/test/main.conf b/test/main.conf
index 994fa4a..a946a45 100644
--- a/test/main.conf
+++ b/test/main.conf
@@ -7,9 +7,10 @@ events {
 }
 
 
-pre_set $name "This is the \$name variable"; # Set a variable
+pre_set $name ""; #" This is the \$name variable"; # Set a variable
 
-pre_if something {
+pre_if ($name = x$name) {
+    the pre_if matched;
     pre_set $var 2;
     # Not visible outside of this pre_if block... hmmmm.
 }