Add macro expansion

2 files changed, 86 insertions, 14 deletions

diff --git a/Main.hs b/Main.hs
index b7e5a2c..d0340fd 100644
--- a/Main.hs
+++ b/Main.hs
@@ -142,9 +142,18 @@ fmt conf = intercalate "\n" $ concatMap dir conf
 
 
 
+data Macro = Macro
+  { mName   :: String
+  , mState  :: PState -- the state in which this macro was defined
+  , mScalar :: [String]
+  , mArray  :: Maybe String
+  , mBlock  :: Maybe String
+  , mCode   :: Conf
+  }
+
 data PState = PState
   { stVars   :: HashMap String [ArgComponent]
-  , stMacros :: HashMap String ([Arg], Conf)
+  , stMacros :: HashMap String Macro
   , stArgs   :: HashMap String [ArgComponent] -- shadows stVars
     -- Max 1, but Prelude's 'lookup' isn't generic to work on Maybe, so this'll do
   , stArray  :: [(String, [Arg])]
@@ -158,6 +167,13 @@ data Error
   | UnknownBlockRef String
   | BlockArg String
   | UnknownArray String
+  | MacroDefBlock String String
+  | MacroDefArray String String
+  | MacroDefVar String
+  | MacroNotEnoughArgs String
+  | MacroTooManyArgs String
+  | MacroNoNeedsBlock String
+  | MacroNeedsBlock String
 
 instance Show Error where
   show MacroNoName = "Macro directive missing or invalid name argument, syntax is \"macro name ..args.. { }\""
@@ -165,7 +181,13 @@ instance Show Error where
   show (UnknownBlockRef n) = "Reference to unknown block variable '&"++n++"'"
   show (BlockArg n) = "Block variable '&"++n++"' may not be used as argument to a directive"
   show (UnknownArray n) = "Reference to unknown variable '&'"++n++"'"
-
+  show (MacroDefBlock n a) = "Block argument '&"++a++"' must be the last in macro definition of '"++n++"'"
+  show (MacroDefArray n a) = "Array argument '@"++a++"' must be last or before block argument in macro definition of '"++n++"'"
+  show (MacroDefVar n) = "Arguments to macro definition of '"++n++"' can only contain variables"
+  show (MacroNotEnoughArgs n) = "Not enough arguments given to macro '"++n++"'"
+  show (MacroTooManyArgs n) = "Too many arguments given to macro '"++n++"'"
+  show (MacroNoNeedsBlock n) = "Macro '"++n++"' does not accept a block argument"
+  show (MacroNeedsBlock n) = "Macro '"++n++"' requires a block argument, but none given"
 
 proc :: Conf -> Either Error Conf
 proc globalconf = pconf (PState mempty mempty mempty mempty mempty) globalconf
@@ -205,17 +227,54 @@ proc globalconf = pconf (PState mempty mempty mempty mempty mempty) globalconf
   stmt st (Directive "macro" a b) =
     case (a,b) of
       (ArgString [Literal n]:_ , Nothing) -> Left (MacroNoBlock n)
-      (ArgString [Literal n]:a', Just b') -> Right (st { stMacros = M.insert n (a', b') (stMacros st) }, []) -- TODO: variable & macro substitution in b'
+      (ArgString [Literal n]:a', Just b') -> (,[]) <$> macro_def st n a' b'
       (_                       , _      ) -> Left MacroNoName
 
-  stmt st (Directive name a b) =
+  stmt st (Directive name a b) = (st,) <$> do
+    a' <- pargs st a
+    b' <- mapM (pconf st) b
     case M.lookup name (stMacros st) of
-      Nothing -> do
-        a' <- pargs st a
-        b' <- mapM (pconf st) b
-        Right (st, [Directive name a' b'])
-      Just _ -> fail "Unimplemented" -- TODO
-
+      Just macro -> macro_expand macro a' b'
+      Nothing    -> Right [Directive name a' b']
+
+  -- macros
+  macro_def :: PState -> String -> [Arg] -> Conf -> Either Error PState
+  macro_def st name arg code =
+    case reverse arg of
+      (ArgBlock b):(ArgArray a):xs -> m xs (Just a) (Just b)
+      (ArgBlock b):xs              -> m xs Nothing  (Just b)
+      (ArgArray a):xs              -> m xs (Just a) Nothing
+      xs                           -> m xs Nothing  Nothing
+    where
+    f (ArgBlock v)                = Left (MacroDefBlock name v)
+    f (ArgArray v)                = Left (MacroDefArray name v)
+    f (ArgString (Variable v:[])) = Right v
+    f _                           = Left (MacroDefVar name)
+    m rscalars a block = do
+      scalars <- mapM f $ reverse rscalars
+      let macro = Macro name st scalars a block code
+      return (st { stMacros = M.insert name macro (stMacros st) })
+
+  macro_expand :: Macro -> [Arg] -> Maybe Conf -> Either Error [Directive]
+  macro_expand m iargs iblock = do
+    (args, leftover) <- genargs mempty (mScalar m) iargs
+    arr <- case (leftover, mArray m) of
+      (a,  Just b)  -> Right [(b, a)]
+      ([], Nothing) -> Right []
+      _             -> Left (MacroTooManyArgs (mName m))
+    block <- case (iblock, mBlock m) of
+      (Just a,  Just b)  -> Right [(b, a)]
+      (Nothing, Nothing) -> Right []
+      (Just _,  Nothing) -> Left (MacroNoNeedsBlock (mName m))
+      (Nothing, Just _)  -> Left (MacroNeedsBlock (mName m))
+    let nst = (mState m) { stArgs = args, stArray = arr, stBlock = block }
+    pconf nst (mCode m)
+    where
+    genargs :: HashMap String [ArgComponent] -> [String] -> [Arg] -> Either Error (HashMap String [ArgComponent], [Arg])
+    -- All arguments are ArgString, enforced by 'interp'
+    genargs vars (n:ns) (ArgString a:as) = genargs (M.insert n a vars) ns as
+    genargs vars [] as = Right (vars, as)
+    genargs _ _ _ = Left (MacroNotEnoughArgs (mName m))
 
 
 
diff --git a/test.conf b/test.conf
index 17f781c..0deb562 100644
--- a/test.conf
+++ b/test.conf
@@ -14,10 +14,18 @@ pre_if something {
     # Not visible outside of this pre_if block... hmmmm.
 }
 
+macro bind_tls {
+    listen 0.0.0.0:80 tls;
+    description $name; # Global $name
+}
+
 # Macro <name> <arg1> <arg2> .. <contents>
 # Arguments can be a:
 #   $var  -> scalar argument
-#   @var  -> array argument, can only be passed to other directives
+#   @var  -> array argument,
+#            represents zero or more arguments,
+#            can only be passed to other directives,
+#            if present, must be last argument or before &var
 #   &var  -> block argument, must be the last argument, if present
 macro server_https $name @alias &block {
     # $name here shadows the global $name
@@ -26,10 +34,15 @@ macro server_https $name @alias &block {
 
     # Anything can go inside the macro contents
     server {
-        listen 0.0.0.0:80 tls;
+        # Macro invocation inside a macro; $name, @alias, &block and $something
+        # are not available to the macro.
+        bind_tls;
+
         server_name $name @alias;
         cert_something "/etc/nginx/certs/$name.crt";
-        &block; # expands to the block argument, inside this block, $name is the global name again and $something is not available
+
+        # expands to the block argument, same rules as a macro invocation:
+        &block;
     }
 }
 
@@ -39,5 +52,5 @@ http {
         if "x"{}
     }
     document_root "/var/tmp/\$va\"r .log";
-    #server_https blicky.net www.blicky.net {}
+    server_https blicky.net www.blicky.net more.blicky.net {hi;}
 }