summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2018-01-08 21:28:24 +0100
committerYorhel <git@yorhel.nl>2018-01-08 21:28:24 +0100
commiteb683aa0df23aae925cfa045e808f27749bfb747 (patch)
treebf66b27d167b142bf611bfb586c1719e68abc3ca
parentd6c6a50fc197840ef32043083ccaf78940273390 (diff)
Mostly untested first attempt at preprocessing
-rw-r--r--Main.hs110
-rw-r--r--nginx-confgen.cabal9
-rw-r--r--test.conf13
3 files changed, 111 insertions, 21 deletions
diff --git a/Main.hs b/Main.hs
index 66212ab..b7e5a2c 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,26 +1,31 @@
+{-# LANGUAGE TupleSections #-}
module Main where
-import Control.Applicative (empty)
-import Control.Monad (void)
-import Data.Void
-import Data.Char (isSpace)
-import Data.List (intercalate)
-import Text.Megaparsec
-import Text.Megaparsec.Char
+import Control.Applicative (empty)
+import Control.Monad (void,foldM)
+import Data.Char (isSpace)
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as M
+import Data.List (intercalate)
+import Data.Void
+import Text.Megaparsec
+import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
+-- Config file AST
+
type Conf = [Directive]
data Directive
= Directive String [Arg] (Maybe Conf)
- | BlockRef String
+ | BlockRef String -- extension
deriving Show
data Arg
= ArgString [ArgComponent]
- | ArgArray String
- | ArgBlock String
+ | ArgArray String -- extension
+ | ArgBlock String -- extension
deriving Show
data ArgComponent
@@ -101,8 +106,9 @@ parser = between ws eof $ many stmt
+
fmt :: Conf -> String
-fmt content = intercalate "\n" $ concatMap dir content
+fmt conf = intercalate "\n" $ concatMap dir conf
where
indent = map (" "++)
escape q = concatMap (\c -> if c == q then ['\\', c] else [c])
@@ -135,8 +141,88 @@ fmt content = intercalate "\n" $ concatMap dir content
+
+data PState = PState
+ { stVars :: HashMap String [ArgComponent]
+ , stMacros :: HashMap String ([Arg], Conf)
+ , 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])]
+ , stBlock :: [(String, Conf)]
+ }
+
+-- TODO: Add source locations to these errors
+data Error
+ = MacroNoName
+ | MacroNoBlock String
+ | UnknownBlockRef String
+ | BlockArg String
+ | UnknownArray String
+
+instance Show Error where
+ show MacroNoName = "Macro directive missing or invalid name argument, syntax is \"macro name ..args.. { }\""
+ show (MacroNoBlock n) = "Macro '"++n++"' has no block argument, syntax is \"macro name ..args.. { }\""
+ 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++"'"
+
+
+proc :: Conf -> Either Error Conf
+proc globalconf = pconf (PState mempty mempty mempty mempty mempty) globalconf
+ where
+ -- Kind of like concatMap with error handling and internal state
+ proc' :: (PState -> a -> Either Error (PState, [a])) -> PState -> [a] -> Either Error [a]
+ proc' f st a = snd <$> foldM p (st, []) a
+ where p (st', a') i = (fmap . fmap) (a'++) (f st' i)
+
+ pconf = proc' stmt -- Process a Conf
+ pargs = proc' interp -- Process [Arg]
+
+ interp :: PState -> Arg -> Either Error (PState, [Arg])
+ interp st a = (st,) <$> case a of
+ ArgBlock n -> Left (BlockArg n)
+ ArgArray n ->
+ case lookup n (stArray st) of
+ Nothing -> Left (UnknownArray n)
+ Just l -> Right l -- No interpolation necessary I think, should have been processed at call site
+ ArgString l -> Right $ (:[]) $ ArgString $ concatMap f l
+ where
+ f (Variable n) =
+ case (M.lookup n (stArgs st), M.lookup n (stVars st)) of
+ (Just v, _) -> v
+ (_, Just v) -> v
+ _ -> [Variable n] -- Unknown variables are assumed to be run-time variables, so are passed through
+ f v = [v]
+
+ -- directives
+ stmt :: PState -> Directive -> Either Error (PState, [Directive])
+
+ stmt st (BlockRef n) =
+ case lookup n (stBlock st) of
+ Nothing -> Left (UnknownBlockRef n)
+ Just b -> Right (st, b) -- All further processing on b should already have been done at call site
+
+ 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'
+ (_ , _ ) -> Left MacroNoName
+
+ stmt st (Directive name a 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
+
+
+
+
main :: IO ()
main = interact $ \s ->
case parse parser "-" s of
Left e -> parseErrorPretty e
- Right r -> fmt r ++ "\n"
+ Right r -> case proc r of
+ Left e -> show e ++ "\n"
+ Right r' -> fmt r' ++ "\n"
diff --git a/nginx-confgen.cabal b/nginx-confgen.cabal
index f9bebbf..d36d317 100644
--- a/nginx-confgen.cabal
+++ b/nginx-confgen.cabal
@@ -18,12 +18,5 @@ executable nginx-confgen
main-is: Main.hs
default-language: Haskell2010
build-depends: base
- , bytestring
- --, containers
- --, directory
- --, filepath
, megaparsec
- --, mtl
- --, optparse-applicative
- --, pcre-light
- , text
+ , unordered-containers
diff --git a/test.conf b/test.conf
index 2822f16..17f781c 100644
--- a/test.conf
+++ b/test.conf
@@ -7,18 +7,29 @@ events {
}
+pre_set $name 1; # Set a variable
+
+pre_if something {
+ pre_set $var 2;
+ # Not visible outside of this pre_if block... hmmmm.
+}
+
# Macro <name> <arg1> <arg2> .. <contents>
# Arguments can be a:
# $var -> scalar argument
# @var -> array argument, can only be passed to other directives
# &var -> block argument, must be the last argument, if present
macro server_https $name @alias &block {
+ # $name here shadows the global $name
+
+ set $something 2;
+
# Anything can go inside the macro contents
server {
listen 0.0.0.0:80 tls;
server_name $name @alias;
cert_something "/etc/nginx/certs/$name.crt";
- &block; # expands to the block argument
+ &block; # expands to the block argument, inside this block, $name is the global name again and $something is not available
}
}