add agents rule file for docs

AGENTS.md

@@ -1,166 +0,0 @@
-# AGENTS.md
-
-FWL (Firewall Language) is a Haskell DSL that compiles to nftables JSON.
-Stack: GHC 9.10.3, Cabal, Parsec 3.x, Aeson 2.x, Tasty/HUnit for tests.
-
----
-
-## Key Commands
-
-```bash
-cabal build              # build everything
-cabal test               # run all test suites
-cabal run fwlc -- check examples/router.fwl    # parse + type-check a source file
-cabal run fwlc -- compile examples/router.fwl  # emit nftables JSON to stdout
-cabal run fwlc -- pretty examples/router.fwl   # pretty-print the parsed AST
-```
-
-Run tests before marking any task complete. The test suite is `cabal test`.
-
----
-
-## Project Structure
-
-```
-fwl/
-├── AGENTS.md
-├── doc/
-│   ├── proposal.md         ← initial design document and exploration
-│   ├── fwl_grammar.md      ← authoritative grammar reference; keep in sync with Parser.hs
-│   └── ref/
-│       ├── ruleset.nft     ← example nftables ruleset
-│       └── ruleset.json    ← the same example nftables ruleset in json format
-├── examples/
-│   └── router.fwl          ← canonical example; must parse and compile cleanly
-├── src/FWL/
-│   ├── AST.hs              ← all data types; source of truth for the AST
-│   ├── Lexer.hs            ← Parsec TokenParser, reservedNames, reservedOpNames
-│   ├── Parser.hs           ← top-level parser, all sub-parsers
-│   ├── Pretty.hs           ← AST → FWL source (round-trip printer)
-│   ├── TypeCheck.hs        ← effect row checker, exhaustiveness, CIDR intervals
-│   ├── Interpret.hs        ← evaluator + effect dispatch
-│   ├── Compile.hs          ← AST → nftables JSON (Aeson Value)
-│   └── Util.hs             ← shared helpers
-└── test/
-    ├── Main.hs
-    ├── ParserTests.hs
-    ├── TypeCheckTests.hs
-    └── CompileTests.hs
-```
-
-The grammar document at `docs/grammar.md` must stay in sync with `Parser.hs` and `Lexer.hs`.
-When changing the parser, update the grammar doc in the same commit.
-
----
-
-## Architecture
-
-The pipeline is strictly linear with no back-edges:
-
-```
-source text
-  → Lexer (Text.Parsec.Token)
-  → Parser   → [Decl]     (AST.hs)
-  → TypeCheck → TypedDecl
-  → Compile   → Aeson Value  (nftables JSON)
-```
-
-The interpreter (`Interpret.hs`) runs the policy against a mock packet environment
-and is separate from the compiler. It uses the same typed AST.
-
----
-
-## Reserved Words Rule
-
-**Only syntactic keywords belong in `reservedNames` in `Lexer.hs`.**
-A word is a syntactic keyword if and only if `Parser.hs` uses `reserved "word"` for it.
-
-Semantic values — action constructors (`Allow`, `Drop`, `Masquerade`),
-effect labels (`Log`, `Warn`, `Error`), result constructors (`Matched`, `Unmatched`),
-and type names (`Frame`, `FlowPattern`, `Action`) — must NOT be in `reservedNames`.
-They are parsed as plain identifiers so they can appear in type, pattern,
-and expression positions without causing parse errors.
-
-If you add a new keyword: add it to both `reservedNames` in `Lexer.hs`
-AND use `reserved "word"` in `Parser.hs`. Never add a word to only one place.
-
----
-
-## IP Address Representation
-
-IP addresses are stored as plain `Integer` in the AST (see `AST.hs`):
-
-- **IPv4**: 32-bit value in the low 32 bits of `Integer`.
-- **IPv6**: 128-bit value. All standard notations are supported including `::` compression
-  and embedded IPv4 (e.g. `::ffff:192.168.1.1`).
-- **CIDR**: `(Literal, Int)` — base address literal + prefix length.
-- **Validation**: host bits must be zero: `(addr .&. hostMask prefix bits) == 0`.
-
-Use `ipv4Lit a b c d` from `AST.hs` to construct IPv4 literals in tests.
-Never use tuple `(Word8, Word8, Word8, Word8)` — that type is gone.
-
----
-
-## Priority
-
-`Priority` is `newtype Priority = Priority { priorityValue :: Int }`.
-Named constants are resolved at parse time in `priorityP`:
-
-| Name        | Value |
-|-------------|-------|
-| `Raw`       | -300  |
-| `ConnTrack` | -200  |
-| `Mangle`    | -150  |
-| `DstNat`    | -100  |
-| `Filter`    | 0     |
-| `SrcNat`    | 100   |
-
-The compiler emits `"prio": <int>` — always an integer in the nftables JSON,
-never a string. Do not use the old `priorityStr` function (deleted).
-
----
-
-## Parser Conventions
-
-- All blocks use explicit `{ }` delimiters with trailing `;` on each item.
-  `endBy p semi` (not `semiSep`) is used wherever trailing semicolons are expected.
-- `mapLit` must be tried **before** `setLit` in `atom` — both start with `{`
-  and `mapLit` consumes `{ expr -> expr }` which `setLit` would misparse.
-- `framePat` must be wrapped in `try` in the `pat` alternatives — it is a
-  reserved-word-prefixed parser that can fail after consuming input.
-- Port literals (`:22`, `:8080`) in record field patterns use `fieldLiteral`,
-  not `literal` — the base `literal` parser does not handle `:N` syntax.
-- `Frame` and `FlowPattern` are NOT in `reservedNames`; they appear as type
-  names and must be accepted by `identifier`.
-
----
-
-## Testing Conventions
-
-- Test files use `{-# LANGUAGE OverloadedStrings #-}` — required because
-  `A.String` expects `Data.Text.Text`, not `String`.
-- IP address assertions use `LIP IPv4 n` / `LIP IPv6 n`, not the old
-  `LIPv4 (a,b,c,d)` tuple constructors.
-- Priority assertions use `Priority n` directly, e.g. `Priority 0`, `Priority (-100)`.
-- All parse tests must compile and pass before any PR is merged.
-
----
-
-## Boundaries
-
-### ✅ Safe to do without asking
-- Read any file, list directories
-- Run `cabal build`, `cabal test`, `cabal run fwlc`
-- Edit `src/`, `test/`, `examples/`, `docs/`
-- Add new test cases to existing test files
-
-### ⚠️ Ask first
-- Add or remove Cabal dependencies (`fwl.cabal`)
-- Rename or delete source modules
-- Change the nftables JSON schema emitted by `Compile.hs`
-- Modify `examples/router.fwl` in ways that change its semantics
-
-### 🚫 Never
-- Add semantic value names (`Allow`, `Drop`, `Log`, etc.) to `reservedNames`
-- Break the `cabal test` suite
-- Emit nftables `"prio"` as a string — it must always be an integer

app/Main.hs

@@ -3,12 +3,11 @@ module Main where
 import System.Environment (getArgs)
 import System.Exit (exitFailure, exitSuccess)
 import System.IO (hPutStrLn, stderr)
-import qualified Data.ByteString.Lazy.Char8 as BL
 
 import FWL.Parser  (parseFile)
 import FWL.Pretty  (prettyProgram)
 import FWL.Check   (checkProgram)
-import FWL.Compile (compileToJson)
+import FWL.Compile (compileToJson, compileProgram)
 
 main :: IO ()
 main = do
@@ -33,7 +32,9 @@ runCheck fp = do
       let errs = checkProgram prog
       if null errs
         then putStrLn "OK" >> exitSuccess
-        else mapM_ (hPutStrLn stderr . show) errs >> exitFailure
+        else do
+          mapM_ (hPutStrLn stderr . show) errs
+          exitFailure
 
 runCompile :: FilePath -> IO ()
 runCompile fp = do
@@ -43,8 +44,10 @@ runCompile fp = do
     Right prog -> do
       let errs = checkProgram prog
       if null errs
-        then BL.putStrLn (compileToJson prog)
-        else mapM_ (hPutStrLn stderr . ("Check error: " ++) . show) errs >> exitFailure
+        then putStrLn (compileToJson prog)
+        else do
+          mapM_ (hPutStrLn stderr . ("Check error: " ++) . show) errs
+          exitFailure
 
 runPretty :: FilePath -> IO ()
 runPretty fp = do

doc/fwl_grammar.md

@@ -1,27 +1,49 @@
-# FWL Grammar Specification
+# FWL Grammar Specification (MVP)
 
-> **Version:** MVP  
-> **Last updated:** May 2026  
-> This document is the authoritative grammar reference for the Firewall Language (FWL).
-> It supersedes the syntax examples in `proposal.md` and reflects the current parser implementation.
+## Overview
+
+FWL is a typed, functional DSL that compiles to nftables JSON. Programs are
+sequences of top-level declarations. The grammar uses explicit braces and
+semicolons throughout — no indentation sensitivity. Types are mandatory on all
+top-level declarations for MVP; inference is deferred to a later version.
+
+The target nftables table is a single table named `fwl` by default
+(configurable via a top-level `config` declaration). Both filter and NAT
+policies compile into this one table.
 
 ---
 
-## Design Principles
+## Notation
 
-- **Explicit delimiters everywhere** — all blocks use `{` `}` with trailing `;` on each item. No layout/indentation sensitivity.
-- **Syntactic keywords are reserved** — only words that structurally delimit declarations or expressions are in `reservedNames`. Semantic values (action names, effect labels, constructors) are plain identifiers.
-- **Types are explicit** — top-level declarations carry full type annotations in the MVP.
-- **Patterns vs. guards are strictly separated** — structural decomposition happens in patterns; boolean predicates over bound names happen in guards.
-- **IP addresses are integers** — IPv4 is a 32-bit value; IPv6 is a 128-bit value. Named priority constants (`Filter`, `SrcNat`, etc.) lower to their canonical integer values at parse time.
+```
+::=   production
+|     alternative
+{ x } zero or more repetitions of x
+[ x ] optional x
+```
+
+String terminals are written in `"double quotes"`. Regex-like character classes
+use `[a-z]`, etc.
 
 ---
 
-## Top-Level Program
+## Top-Level Structure
 
 ```ebnf
-program         ::= { decl }
+program     ::= { config } { decl }
 
+config      ::= "config" "{" { configProp ";" } "}"
+
+configProp  ::= "table" "=" stringLit
+```
+
+Every non-`config` declaration is terminated by `";"`.
+
+---
+
+## Declarations
+
+```ebnf
 decl        ::= interfaceDecl
               | zoneDecl
               | importDecl
@@ -32,9 +54,7 @@ decl            ::= interfaceDecl
               | policyDecl
 ```
 
----
-
-## Declarations
+### Interface
 
 ```ebnf
 interfaceDecl ::= "interface" ident ":" ifaceKind "{" { ifaceProp ";" } "}" ";"
@@ -46,323 +66,429 @@ ifaceProp       ::= "dynamic"
                 | "cidr6" "=" cidrSet
 
 cidrSet       ::= "{" cidrLit { "," cidrLit } "}"
+```
 
+### Zone
+
+```ebnf
 zoneDecl    ::= "zone" ident "=" "{" ident { "," ident } "}" ";"
+```
 
+### Import
+
+```ebnf
 importDecl  ::= "import" ident ":" type "from" stringLit ";"
+```
 
+### Let
+
+```ebnf
 letDecl     ::= "let" ident ":" type "=" expr ";"
+```
 
-patternDecl     ::= "pattern" ident ":" type "=" pat ";"
+### Pattern
 
+Named patterns are first-class; they may appear anywhere a structural pattern
+appears, including nested inside constructor patterns, `Frame(...)`, and other
+named patterns.
+
+```ebnf
+patternDecl ::= "pattern" ident ":" type "=" packetPat ";"
+```
+
+Named patterns are resolved during type-checking, not by macro-expanding at
+parse time. Recursive named patterns are a type error.
+
+### Flow
+
+```ebnf
 flowDecl    ::= "flow" ident ":" "FlowPattern" "=" flowExpr ";"
-flowExpr        ::= ident
-                  | ident "." ident "within" duration
 
+flowExpr    ::= seqExpr
+
+seqExpr     ::= flowAtom
+              | flowAtom "." seqExpr
+              | flowAtom "." seqExpr "within" duration
+```
+
+A `within` clause applies to the entire sequence to its left and binds most
+tightly to the innermost `.`. For MVP, `within` is only valid at the top level
+of a `flowExpr`.
+
+```ebnf
+flowAtom    ::= ident
+```
+
+### Rule
+
+Rules are reusable, named packet-processing functions. They receive a `Frame`
+and return an `Action` (possibly via effects).
+
+```ebnf
 ruleDecl    ::= "rule" ident ":" type "=" lambdaExpr ";"
 
-policyDecl      ::= "policy" ident ":" type
-                    "on" "{"
-                      "hook" "=" hook ","
-                      "table" "=" tableName ","
-                      "priority" "=" priority
-                    "}"
-                    "=" armBlock ";"
-```
-
-### Policy Metadata
-
-```ebnf
-hook            ::= "Input" | "Forward" | "Output" | "Prerouting" | "Postrouting"
-
-tableName       ::= "Filter" | "NAT" | ident
-
--- Priority is always an integer in nftables JSON.
--- Named constants are resolved at parse time:
---   Raw = -300, ConnTrack = -200, Mangle = -150,
---   DstNat = -100, Filter = 0, SrcNat = 100
-priority        ::= "Filter" | "DstNat" | "SrcNat" | "Mangle"
-                  | "Raw"    | "ConnTrack"
-                  | [ "-" ] nat
-```
-
----
-
-## Types
-
-```ebnf
-type            ::= simpleType
-                  | simpleType "->" type          -- function type
-                  | "<" effectList ">" type        -- effectful function type
-
-simpleType      ::= ident                          -- type name (Frame, Action, IP, etc.)
-                  | ident "<" typeList ">"          -- generic: Map<K,V>, Bytes<{}>
-                  | "(" type { "," type } ")"       -- tuple type
-
-typeList        ::= type { "," type }
-effectList      ::= ident { "," ident }
-```
-
-> **Note:** `Frame`, `FlowPattern`, and all action/effect type names (`Action`, `CIDRSet`, etc.)
-> are plain identifiers in the type parser — they are **not** reserved keywords.
-
----
-
-## Expressions
-
-```ebnf
 lambdaExpr  ::= "\" ident "->" expr
-                  | expr
+```
 
-expr            ::= ifExpr
-                  | doExpr
-                  | infixExpr
+A `rule` body must be a lambda at the top level for MVP.
 
-ifExpr          ::= "if" expr "then" expr "else" expr
+### Policy
 
-doExpr          ::= "do" "{" stmt { ";" stmt } "}"
-stmt            ::= "let" ident "=" expr
-                  | ident "<-" expr
-                  | expr
+Policies are the entry points tied to nftables hooks. A policy body is a
+bare arm-block (no `case ... of` wrapper; the matched value is always the
+bound `Frame`-like parameter of the policy).
 
-infixExpr       ::= prefixExpr { infixOp prefixExpr }
-infixOp         ::= "&&" | "||" | "==" | "!=" | "<" | "<=" | ">" | ">="
-                  | "++" | ">>" | ">>=" | "∈" | "in"
+```ebnf
+policyDecl  ::= "policy" ident ":" type
+                "on" "{" hookSpec "}"
+                "=" armBlock ";"
 
-prefixExpr      ::= "!" prefixExpr | appExpr
+hookSpec    ::= hookProp "," hookProp "," hookProp
+              | hookProp "," hookProp "," hookProp ","   -- trailing comma OK
 
-appExpr         ::= atom { atom }
+hookProp    ::= "hook"     "=" hook
+              | "table"    "=" tableName
+              | "priority" "=" priority
 
-atom            ::= performExpr
-                  | mapLit               -- { expr -> expr, ... }  tried before setLit
-                  | setLit               -- { expr, ... }
-                  | tupleLit             -- ( expr, expr, ... )   requires ≥ 2
-                  | "(" expr ")"
-                  | literal
-                  | portLit              -- :22  :8080
-                  | qualName             -- foo  foo.bar  foo.bar.baz
+hook        ::= "Input" | "Forward" | "Output" | "Prerouting" | "Postrouting"
+tableName   ::= "Filter" | "NAT"
+priority    ::= "Filter" | "DstNat" | "SrcNat" | "Mangle" | intLit
+```
 
-performExpr     ::= "perform" qualName "(" argList? ")"
-argList         ::= expr { "," expr }
+---
 
-mapLit          ::= "{" mapEntry { "," mapEntry } "}"
-mapEntry        ::= expr "->" expr
+## Arm Blocks
 
-setLit          ::= "{" expr { "," expr } "}"
-tupleLit        ::= "(" expr "," expr { "," expr } ")"
+Used uniformly inside `rule` bodies (via `case`) and `policy` bodies.
 
-qualName        ::= ident { "." ident }
+```ebnf
+armBlock    ::= "{" { arm } "}"
+
+arm         ::= "|" pat guardOpt "->" expr ";"
+
+guardOpt    ::= ε
+              | "if" expr
 ```
 
 ---
 
 ## Patterns
 
+Patterns describe packet structure and bind names. All membership/comparison
+predicates are guards (see § Expressions), not patterns — except for field
+constraints inside record patterns, which are written as field predicates.
+
 ```ebnf
-pat             ::= wildcardPat          -- _
-                  | framePat             -- Frame(...)
-                  | tuplePat             -- (p, p, ...)   requires ≥ 2
-                  | bytesPat             -- [ byteElem* ]
-                  | recordPat            -- Ctor { field = lit, ... }
-                  | namedOrCtorPat       -- Ctor(p,...) or bare identifier
+pat         ::= "_"                          -- wildcard
+              | ident                        -- variable binding
+              | namedPat                     -- first-class named pattern
+              | ctorPat                      -- e.g., IPv4(ip, ...)
+              | recordPat                    -- e.g., tcp { dport = :22 }
+              | tuplePat                     -- e.g., (udp, payload)
+              | framePat                     -- Frame(path, inner)
+              | bytePat                      -- e.g., [0x01 _*]
 
-wildcardPat     ::= "_"
-framePat        ::= "Frame" "(" frameArgs ")"
-frameArgs       ::= pathPat "," pat      -- with explicit path
-                  | pat                  -- path inferred
+-- A named pattern reference; resolved at type-check time.
+-- Binds NO additional names itself (names are bound in the pattern's definition).
+namedPat    ::= ident   -- must refer to a declared pattern
+
+ctorPat     ::= ident "(" patList ")"
+patList     ::= pat { "," pat }
+
+recordPat   ::= ident "{" [ fieldPatList ] "}"
+fieldPatList::= fieldPat { "," fieldPat }
+fieldPat    ::= ident "=" literal            -- equality constraint
+              | ident                        -- bind field to same-named variable
+              | ident "as" ident             -- bind field to fresh variable
+
+tuplePat    ::= "(" pat { "," pat } ")"
+
+-- Frame pattern: optional interface-path specifier, then inner packet pattern.
+framePat    ::= "Frame" "(" [ pathPat "," ] pat ")"
+
+-- Interface-path: source, destination, or both.
+pathPat     ::= endpointPat
+              | endpointPat "->" endpointPat
 
-pathPat         ::= endpointPat? ( "->" endpointPat? )?
 endpointPat ::= "_"
-                  | ident "in" ident     -- iif in lan_zone
-                  | ident "∈" ident
-                  | ident
+              | ident                        -- exact interface name
+              | ident "in" ident             -- interface is member of zone
+```
 
-tuplePat        ::= "(" pat "," pat { "," pat } ")"
+**Note on `∈`:** the parser accepts both the Unicode `∈` and the ASCII keyword
+`in` as synonyms in all positions. The AST stores a single `MemberOf`
+constructor.
 
-bytesPat        ::= "[" byteElem* "]"
-byteElem        ::= hexByte              -- 0xff
-                  | "_"                  -- any byte
-                  | "_" "*"              -- zero or more bytes
+### Byte Patterns
 
-recordPat       ::= ident "{" fieldPat { "," fieldPat } "}"
-fieldPat        ::= ident "=" fieldLit   -- exact match
-                  | ident "in" expr      -- membership
-                  | ident "∈" expr
-                  | ident "as" ident     -- bind with alias
-                  | ident               -- bind to same name
+Used in `pattern` declarations for payload matching.
 
--- fieldLit extends literal with port syntax
-fieldLit        ::= ":" nat | literal
-
-namedOrCtorPat  ::= ident "(" pat { "," pat } ")"   -- constructor with args
-                  | ident                             -- variable or nullary ctor
+```ebnf
+bytePat     ::= "[" { byteElem } "]"
+byteElem    ::= hexByte                      -- e.g., 0x01
+              | "_"                          -- any single byte
+              | "_*"                         -- zero or more bytes
 ```
 
 ---
 
-## Case Arms
+## Expressions
 
 ```ebnf
-armBlock        ::= "{" { arm } "}"
+expr        ::= letExpr
+              | ifExpr
+              | doExpr
+              | caseExpr
+              | infixExpr
 
-arm             ::= "|" pat ( "if" expr )? "->" expr ";"
+letExpr     ::= "let" ident "=" expr "in" expr
+
+ifExpr      ::= "if" expr "then" expr "else" expr
+
+doExpr      ::= "do" "{" doStmt { ";" doStmt } "}"
+doStmt      ::= ident "<-" expr              -- effectful bind
+              | expr                         -- effectful sequence
+
+caseExpr    ::= "case" expr "of" armBlock
+
+infixExpr   ::= prefixExpr { infixOp prefixExpr }
+
+prefixExpr  ::= appExpr
+              | "!" prefixExpr
+
+appExpr     ::= atom { atom }                -- function application
+
+atom        ::= ident
+              | qualName
+              | literal
+              | tupleLit
+              | setLit
+              | mapLit
+              | performExpr
+              | "(" expr ")"
+
+performExpr ::= "perform" qualName "(" [ argList ] ")"
+
+tupleLit    ::= "(" expr "," expr { "," expr } ")"
+setLit      ::= "{" [ expr { "," expr } ] "}"
+mapLit      ::= "{" mapEntry { "," mapEntry } "}"
+mapEntry    ::= expr "->" expr
+
+argList     ::= expr { "," expr }
+
+qualName    ::= ident { "." ident }
+
+infixOp     ::= "&&" | "||"
+              | "==" | "!=" | "<" | "<=" | ">" | ">="
+              | "in" | "∈"                   -- set/zone membership
+              | "++"                         -- string/list concat
+              | ">>"                         -- effect sequencing
+              | ">>="                        -- monadic bind
 ```
 
+**Operator precedence** (high to low):
+
+| Level | Operators             | Assoc |
+|-------|-----------------------|-------|
+| 7     | application           | left  |
+| 6     | `==` `!=` `<` `<=` `>` `>=` `in` `∈` | none |
+| 5     | `&&`                  | right |
+| 4     | `\|\|`               | right |
+| 3     | `++`                  | right |
+| 2     | `>>=`                 | left  |
+| 1     | `>>`                  | left  |
+
+---
+
+## Types
+
+```ebnf
+type        ::= funType
+
+funType     ::= effectType
+              | effectType "->" funType
+
+effectType  ::= "<" [ ident { "," ident } ] ">" simpleType
+              | simpleType
+
+simpleType  ::= ident [ "<" typeList ">" ]   -- parameterised type
+              | "(" type { "," type } ")"    -- tuple type
+              | "(" type ")"                 -- grouped
+
+typeList    ::= type { "," type }
+```
+
+Effect rows use angle brackets: `<FlowMatch, Log> Action`.
+
+For MVP, effect annotations are required on `rule` declarations that contain
+`perform` expressions and are optional on `policy` declarations.
+
+---
+
+## Actions
+
+`Action` is a built-in type. Its constructors are:
+
+```ebnf
+action      ::= "Allow"
+              | "Drop"
+              | "Continue"
+              | "Masquerade"
+              | "DNAT" "(" expr ")"
+              | "DNATMap" "(" expr ")"
+              | "Log" "(" logLevel "," expr ")"
+
+logLevel    ::= "Info" | "Warn" | "Error"
+```
+
+`Continue` is a legal action value and compiles to nothing (a no-op pass-
+through). It is used to make exhaustive arm blocks typecheck when earlier arms
+handle all interesting cases. A policy arm that returns `Continue` as the last
+arm is a type error (unreachable or missing terminator); a `rule` arm may
+return `Continue` to signal "pass control back to the caller."
+
+---
+
+## Effects
+
+The built-in effects available for MVP are:
+
+| Effect     | Operations                                        |
+|------------|---------------------------------------------------|
+| `FlowMatch`| `FlowMatch.check(flowId, pattern) : MatchResult`  |
+| `Log`      | `Log.emit(level, msg) : ()`                       |
+| `FIB`      | `FIB.daddrLocal(ip) : Bool`                       |
+
+`MatchResult` constructors: `Matched`, `Unmatched`.
+
+Additional effects may be declared by the user in a future version.
+
 ---
 
 ## Literals
 
 ```ebnf
-literal         ::= ipOrCidrLit
-                  | hexByte              -- 0xff
-                  | "true" | "false"
-                  | stringLit            -- "..."
-                  | nat                  -- decimal integer
+literal     ::= intLit
+              | stringLit
+              | boolLit
+              | ipv4Lit
+              | ipv6Lit
+              | cidrLit
+              | portLit
+              | durationLit
+              | hexByte
 
-portLit         ::= ":" nat             -- :22, :8080, :51944
-
-ipOrCidrLit     ::= ipLit ( "/" nat )?   -- optional prefix → CIDR
-
-ipLit           ::= ipv6Lit | ipv4Lit
-
--- IPv4: four decimal octets 0-255
+intLit      ::= ["-"] digit+
+stringLit   ::= '"' { strChar } '"'
+boolLit     ::= "true" | "false"
 ipv4Lit     ::= octet "." octet "." octet "." octet
-octet           ::= nat                  -- 0..255
-
--- IPv6: full or compressed notation, optional embedded IPv4
--- All standard forms are supported:
---   full:        2001:0db8:85a3:0000:0000:8a2e:0370:7334
---   compressed:  2001:db8::8a2e:370:7334
---   loopback:    ::1
---   any:         ::
---   link-local:  fe80::1
---   IPv4-mapped: ::ffff:192.168.1.1
-ipv6Lit         ::= ipv6Groups
-ipv6Groups      ::= "::" ipv6RightGroups?           -- starts with ::
-                  | ipv6LeftGroups ( "::" ipv6RightGroups? )?
-ipv6LeftGroups  ::= hex16 { ":" hex16 }             -- stops before ::
-ipv6RightGroups ::= ipv4EmbeddedGroups | ipv6LeftGroups
-ipv4EmbeddedGroups ::= { hex16 ":" } octet "." octet "." octet "." octet
-hex16           ::= hexDigit+            -- 1-4 hex digits, value 0x0000..0xffff
-
-cidrLit         ::= ipLit "/" nat        -- must be a CIDR (prefix required)
-
-hexByte         ::= "0x" hexDigit hexDigit
-duration        ::= nat timeUnit
+ipv6Lit     ::= -- standard IPv6 notation including "::" compression
+cidrLit     ::= (ipv4Lit | ipv6Lit) "/" digit+
+portLit     ::= ":" digit+             -- e.g., :22, :8080
+durationLit ::= digit+ timeUnit
 timeUnit    ::= "s" | "ms" | "m" | "h"
-```
-
-### Internal IP Representation
-
-IP addresses are stored as plain `Integer` values, not tuples or byte arrays:
-
-| Type  | Storage  | Range            |
-|-------|----------|------------------|
-| IPv4  | 32-bit `Integer` | `0x00000000`..`0xFFFFFFFF` |
-| IPv6  | 128-bit `Integer` | `0x0`..`0xFFFF...FFFF` |
-
-CIDR host-bit validation: `(addr .&. hostMask) == 0` where `hostMask = (1 << (bits - prefix)) - 1`.
-
----
-
-## Reserved Keywords
-
-Only these words are reserved (i.e. `identifier` will reject them):
-
-```
-config    table     interface  zone      import    from
-let       in        pattern    flow      rule      policy    on
-case      of        if         then      else      do        perform
-within    as        dynamic    cidr4     cidr6
-hook      priority
-WAN       LAN       WireGuard
-Input     Forward   Output     Prerouting  Postrouting
-Filter    NAT       Mangle     DstNat      SrcNat
-Raw       ConnTrack
-true      false
-```
-
-The following are **not** reserved and parse as plain identifiers in all positions
-(type names, constructors, action values, effect labels):
-
-```
-Frame     FlowPattern
-Allow     Drop        Continue    Masquerade  DNAT    DNATMap
-Log       Info        Warn        Error
-Matched   Unmatched
-Action    Packet      IP          Port        Protocol
-CIDRSet   Map         Bytes
+hexByte     ::= "0x" hexDigit hexDigit
+octet       ::= digit+   -- 0-255
 ```
 
 ---
 
-## Priority Constants
+## Lexical Rules
 
-Named priorities resolve to integers at parse time:
+```ebnf
+ident       ::= letter { letter | digit | "_" }
+              -- must not be a reserved word
 
-| Name        | Integer value |
-|-------------|---------------|
-| `Raw`       | -300          |
-| `ConnTrack` | -200          |
-| `Mangle`    | -150          |
-| `DstNat`    | -100          |
-| `Filter`    | 0             |
-| `SrcNat`    | 100           |
+reserved    ::= "config" | "interface" | "zone" | "import" | "let" | "in"
+              | "pattern" | "flow" | "rule" | "policy" | "on"
+              | "case" | "of" | "if" | "then" | "else" | "do"
+              | "perform" | "within" | "as"
+              | "WAN" | "LAN" | "WireGuard"
+              | "Input" | "Forward" | "Output" | "Prerouting" | "Postrouting"
+              | "Filter" | "NAT" | "Mangle" | "DstNat" | "SrcNat"
+              | "Allow" | "Drop" | "Continue" | "Masquerade" | "DNAT"
+              | "DNATMap" | "Log" | "Info" | "Warn" | "Error"
+              | "Matched" | "Unmatched"
+              | "dynamic" | "cidr4" | "cidr6" | "table" | "hook" | "priority"
+              | "true" | "false"
+              | "FlowPattern" | "Frame"
 
-Arbitrary integers (including negative, e.g. `-150`) are also accepted.
+comment     ::= "--" { any char except newline }
+              | "{-" { any char } "-}"
+
+whitespace  ::= space | tab | newline | comment
+```
+
+Identifiers beginning with an uppercase letter are treated as constructor
+names by convention; those beginning with lowercase are variables. The lexer
+does not enforce this — it is a naming convention only, checked during
+type-checking.
 
 ---
 
-## Operator Precedence
+## Resolved Inconsistencies from Proposal
 
-From lowest to highest binding:
+The following decisions were made to normalize the proposal's syntax:
 
-| Level | Operators              | Associativity |
-|-------|------------------------|---------------|
-| 1     | `if … then … else`     | —             |
-| 2     | `\|\|`                 | left          |
-| 3     | `&&`                   | left          |
-| 4     | `==`  `!=`             | none          |
-| 5     | `<`  `<=`  `>`  `>=`  | none          |
-| 6     | `∈`  `in`              | none          |
-| 7     | `++`  `>>`  `>>=`     | left          |
-| 8     | `!` (prefix)           | —             |
-| 9     | function application   | left          |
+| Topic | Proposal state | MVP decision |
+|-------|---------------|--------------|
+| Interface body | Multiline, no delimiters | Braced block with `;` separators |
+| Policy body | `where` with indented arms | `=` followed by arm-block |
+| Rule body | `\frame -> case frame of \| ...` | `\ident -> expr`; `case` is a normal expression |
+| Policy vs rule | Distinct surface syntax | Policies use a bare arm-block; rules use `case` explicitly |
+| `Frame<{}>` | Unclear `<{}>` parameter | Parsed but ignored for MVP; written as `Frame` in practice |
+| Named patterns in sub-positions | Unclear | First-class everywhere; resolved at type-check time |
+| `∈` operator | Unicode only | Both `∈` and `in` accepted everywhere |
+| `Continue` | Unclear semantics | Legal `Action` constructor; compiles to nothing; type error if last arm of a policy block |
+| Single nftables table | Not specified | Default table name `fwl`; configurable via `config { table = "name"; }` |
+| `handle` syntax | Mentioned but unspecified | Deferred; MVP only has `perform` |
+| Effect annotations | Inconsistent (`<>` vs `{}`) | Angle brackets `<Eff1, Eff2>` everywhere |
+| Guard vs pattern membership | Mixed | Structural matching in patterns only; `in`/`∈` in guards only (except `fieldPat`) |
 
 ---
 
 ## Canonical Examples
 
-### Interface and zone declarations
+The following examples must all parse under the grammar above.
+
+### 1. Interface and Zone
 
 ```fwl
 interface wan : WAN { dynamic; };
-interface lan  : LAN { cidr4 = { 10.17.1.0/24 }; };
+interface lan : LAN {
+  cidr4 = { 10.17.1.0/24 };
+  cidr6 = { fe80::/10, fd12:3456::/48 };
+};
 interface wg0 : WireGuard {};
 
 zone lan_zone = { lan, wg0 };
 ```
 
-### Map literal
+### 2. Import and Let
 
 ```fwl
+import rfc1918 : CIDRSet from "builtin:rfc1918";
+
 let forwards : Map<(Protocol, Port), (IP, Port)> = {
   (tcp, :8080) -> (10.17.1.10, :80),
   (tcp, :2222) -> (10.17.1.11, :22)
 };
 ```
 
-### Named patterns and flows
+### 3. Pattern and Flow
 
 ```fwl
-pattern WGInitiation : (UDPHeader, Bytes<{}>) =
+pattern WGInitiation : (UDPHeader, Bytes) =
   (udp { length = 156 }, [0x01 _*]);
 
+pattern WGResponse : (UDPHeader, Bytes) =
+  (udp { length = 100 }, [0x02 _*]);
+
 flow WireGuardHandshake : FlowPattern =
   WGInitiation . WGResponse within 5s;
 ```
 
-### Rule with effects
+### 4. Rule with Effects
 
 ```fwl
 rule blockOutboundWG : Frame -> <FlowMatch, Log> Action =
@@ -371,8 +497,9 @@ rule blockOutboundWG : Frame -> <FlowMatch, Log> Action =
       | Frame(iif in lan_zone -> wan, IPv4(ip, UDP(udp, payload)))
           if matches(WGInitiation, (udp, payload)) ->
             case perform FlowMatch.check(flowOf(ip, wg), WireGuardHandshake) of {
-              | Matched -> do {
-                  perform Log.emit(Warn, "WG blocked");
+              | Matched ->
+                  do {
+                    perform Log.emit(Warn, "WG blocked: " ++ show(ip.src));
                     Drop
                   };
               | _ -> Continue;
@@ -381,18 +508,190 @@ rule blockOutboundWG : Frame -> <FlowMatch, Log> Action =
     };
 ```
 
-### Policy
+### 5. Filter Policy
 
 ```fwl
 policy input : Frame
-  on { hook = Input, table = Filter, priority = Filter } =
-  {
+  on { hook = Input, table = Filter, priority = Filter }
+  = {
     | _ if ct.state in { Established, Related } -> Allow;
     | Frame(lo, _) -> Allow;
-    | Frame(_, Ether(_, IPv4(_, TCP(tcp, _))))
+    | Frame(_, IPv6(ip6, ICMPv6(_, _)))
+        if ip6.src in fe80::/10 -> Allow;
+    | Frame(_, IPv4(_, TCP(tcp, _)))
         if tcp.dport == :22 -> Allow;
-    | Frame(_, Ether(_, IPv4(_, UDP(udp, _))))
+    | Frame(_, IPv4(_, UDP(udp, _)))
         if udp.dport == :51944 -> Allow;
     | _ -> Drop;
   };
 ```
+
+### 6. NAT Policy
+
+```fwl
+policy nat_prerouting : Frame
+  on { hook = Prerouting, table = NAT, priority = DstNat }
+  = {
+    | Frame(_, IPv4(ip, _)) ->
+        if perform FIB.daddrLocal(ip.dst)
+        then DNATMap(forwards)
+        else Allow;
+    | _ -> Allow;
+  };
+
+policy nat_postrouting : Frame
+  on { hook = Postrouting, table = NAT, priority = SrcNat }
+  = {
+    | Frame(_ -> wan, IPv4(ip, _)) if ip.src in rfc1918 -> Masquerade;
+    | _ -> Allow;
+  };
+```
+
+### 7. Forward Policy calling a Rule
+
+```fwl
+policy forward : Frame
+  on { hook = Forward, table = Filter, priority = Filter }
+  = {
+    | _ if ct.state in { Established, Related }          -> Allow;
+    | frame if iif in lan_zone && oif == wan             -> blockOutboundWG(frame);
+    | _ if ct.status == DNAT                             -> Allow;
+    | Frame(iif in lan_zone -> wan, _)                   -> Allow;
+    | Frame(iif in lan_zone -> lan_zone, _)              -> Allow;
+    | Frame(wan -> lan_zone, IPv4(ip, TCP(tcp, _)))
+        if (ip.dst, tcp.dport) in forwards               -> Allow;
+    | _                                                  -> Drop;
+  };
+```
+
+---
+
+## Haskell AST Sketch
+
+The following gives the direct mapping from grammar to Haskell types.
+
+```haskell
+-- src/FWL/AST.hs
+
+data Program = Program [Config] [Decl]
+
+data Config = Config { configTable :: Maybe String }
+
+data Decl
+  = DInterface  Name IfaceKind [IfaceProp]
+  | DZone       Name [Name]
+  | DImport     Name Type String
+  | DLet        Name Type Expr
+  | DPattern    Name Type PacketPat
+  | DFlow       Name FlowExpr
+  | DRule       Name Type Expr        -- expr must be LamExpr
+  | DPolicy     Name Type PolicyMeta ArmBlock
+
+data PolicyMeta = PolicyMeta
+  { pmHook     :: Hook
+  , pmTable    :: TableName
+  , pmPriority :: Priority }
+
+data Hook     = Input | Forward | Output | Prerouting | Postrouting
+data TableName= Filter | NAT
+data Priority = PFilter | PDstNat | PSrcNat | PMangle | PInt Int
+
+data IfaceKind = WAN | LAN | WireGuard | IKUser Name
+data IfaceProp = IPDynamic | IPCidr4 [CIDR] | IPCidr6 [CIDR]
+
+-- Patterns
+
+data Pat
+  = PWild
+  | PVar  Name
+  | PNamed Name               -- named pattern reference (first-class)
+  | PCtor Name [Pat]
+  | PRecord Name [FieldPat]
+  | PTuple [Pat]
+  | PFrame (Maybe PathPat) Pat
+  | PBytes [ByteElem]
+
+data FieldPat
+  = FPEq  Name Literal
+  | FPBind Name              -- bind field to same-named var
+  | FPAs  Name Name          -- bind field to fresh var
+
+data PathPat  = PathPat (Maybe EndpointPat) (Maybe EndpointPat)
+data EndpointPat
+  = EPWild
+  | EPName Name
+  | EPMember Name Name       -- iif `in` zoneName
+
+data ByteElem = BEHex Word8 | BEWild | BEWildStar
+
+-- Flow
+
+data FlowExpr
+  = FAtom Name
+  | FSeq  FlowExpr FlowExpr (Maybe Duration)
+
+type Duration = (Int, TimeUnit)
+data TimeUnit = Seconds | Millis | Minutes | Hours
+
+-- Types
+
+data Type
+  = TName Name [Type]
+  | TTuple [Type]
+  | TFun   Type Type
+  | TEffect [Name] Type
+
+-- Expressions
+
+data Expr
+  = EVar  Name
+  | EQual [Name]
+  | ELit  Literal
+  | ELam  Name Expr
+  | EApp  Expr Expr
+  | ECase Expr ArmBlock
+  | EIf   Expr Expr Expr
+  | EDo   [DoStmt]
+  | ELet  Name Expr Expr
+  | ETuple [Expr]
+  | ESet   [Expr]
+  | EMap   [(Expr, Expr)]
+  | EPerform [Name] [Expr]  -- perform QualName(args)
+  | EInfix InfixOp Expr Expr
+  | EPrefix PrefixOp Expr
+
+data InfixOp
+  = OpAnd | OpOr | OpEq | OpNeq | OpLt | OpLte | OpGt | OpGte
+  | OpIn | OpConcat | OpThen | OpBind
+
+data PrefixOp = OpNot
+
+data DoStmt
+  = DSBind Name Expr
+  | DSExpr Expr
+
+type ArmBlock = [Arm]
+data Arm = Arm Pat (Maybe Expr) Expr   -- pattern, guard, body
+
+-- Actions (constructors of the Action type; parsed as Expr constructors)
+-- Allow | Drop | Continue | Masquerade
+-- | DNAT Expr | DNATMap Expr | Log LogLevel Expr
+
+data LogLevel = LInfo | LWarn | LError
+
+-- Literals
+
+data Literal
+  = LInt    Int
+  | LString String
+  | LBool   Bool
+  | LIPv4   (Word8,Word8,Word8,Word8)
+  | LIPv6   [Word16]
+  | LCIDR   Literal Int
+  | LPort   Int
+  | LDuration Int TimeUnit
+  | LHex    Word8
+
+type Name = String
+type CIDR = (Literal, Int)
+```

examples/router.fwl

@@ -1,95 +0,0 @@
--- Example: home router firewall in FWL
--- Compile with: fwlc compile examples/router.fwl
-
-interface wan  : WAN { dynamic; };
-interface lan  : LAN { cidr4 = { 10.17.1.0/24 }; };
-interface wg0  : WireGuard {};
-
-zone lan_zone = { lan, wg0 };
-
-import rfc1918 : CIDRSet from "builtin:rfc1918";
-
-let forwards : Map<(Protocol, Port), (IP, Port)> = {
-  (tcp, :8080) -> (10.17.1.10, :80),
-  (tcp, :2222) -> (10.17.1.11, :22)
-};
-
--- WireGuard handshake detection (compiles to ct mark state machine)
-pattern WGInitiation : (UDPHeader, Bytes) =
-  (udp { length = 156 }, [0x01 _*]);
-
-pattern WGResponse : (UDPHeader, Bytes) =
-  (udp { length = 100 }, [0x02 _*]);
-
-flow WireGuardHandshake : FlowPattern =
-  WGInitiation . WGResponse within 5s;
-
--- Block LAN clients from tunnelling out via WireGuard
-rule blockOutboundWG : Frame -> <FlowMatch, Log> Action =
-  \frame ->
-    case frame of {
-      | Frame(iif in lan_zone -> wan, IPv4(ip, UDP(udp, payload)))
-          if matches(WGInitiation, (udp, payload)) ->
-            case perform FlowMatch.check(flowOf(ip, wg), WireGuardHandshake) of {
-              | Matched -> do {
-                  perform Log.emit(Warn, "WG blocked");
-                  Drop
-                };
-              | _ -> Continue;
-            };
-      | _ -> Continue;
-    };
-
--- Inbound to router
-policy input : Frame
-  on { hook = Input, table = Filter, priority = Filter }
-  = {
-    | _ if ct.state in { Established, Related } -> Allow;
-    | Frame(lo, _)                              -> Allow;
-    | Frame(_, IPv6(ip6, ICMPv6(_, _)))
-        if ip6.src in fe80::/10                 -> Allow;
-    | Frame(_, IPv4(_, TCP(tcp, _)))
-        if tcp.dport == :22                     -> Allow;
-    | Frame(_, IPv4(_, UDP(udp, _)))
-        if udp.dport == :51944                  -> Allow;
-    | _                                         -> Drop;
-  };
-
--- Forwarded traffic
-policy forward : Frame
-  on { hook = Forward, table = Filter, priority = Filter }
-  = {
-    | _ if ct.state in { Established, Related }       -> Allow;
-    | frame if iif in lan_zone && oif == wan          -> blockOutboundWG(frame);
-    | _ if ct.status == DNAT                          -> Allow;
-    | Frame(iif in lan_zone -> wan, _)                -> Allow;
-    | Frame(iif in lan_zone -> lan_zone, _)           -> Allow;
-    | Frame(wan -> lan_zone, IPv4(ip, TCP(tcp, _)))
-        if (ip.dst, tcp.dport) in forwards            -> Allow;
-    | _                                               -> Drop;
-  };
-
--- Outbound from router
-policy output : Frame
-  on { hook = Output, table = Filter, priority = Filter }
-  = {
-    | _ -> Allow;
-  };
-
--- NAT
-policy nat_prerouting : Frame
-  on { hook = Prerouting, table = NAT, priority = DstNat }
-  = {
-    | Frame(_, IPv4(ip, _)) ->
-        if perform FIB.daddrLocal(ip.dst)
-        then DNATMap(forwards)
-        else Allow;
-    | _ -> Allow;
-  };
-
-policy nat_postrouting : Frame
-  on { hook = Postrouting, table = NAT, priority = SrcNat }
-  = {
-    | Frame(_ -> wan, IPv4(ip, _)) if ip.src in rfc1918 -> Masquerade;
-    | _ -> Allow;
-  };

fwl.cabal

@@ -36,23 +36,3 @@ executable fwlc
   hs-source-dirs:   app
   build-depends:
       base, fwl, text, aeson-pretty, bytestring
-
-test-suite fwl-tests
-  import:           shared
-  type:             exitcode-stdio-1.0
-  main-is:          Spec.hs
-  hs-source-dirs:   test
-  other-modules:
-      FWL.Util
-    , ParserTests
-    , CheckTests
-    , CompileTests
-  build-depends:
-      base, fwl
-    , tasty           >= 1.4
-    , tasty-hunit     >= 0.10
-    , aeson           >= 2.0
-    , aeson-pretty    >= 0.8
-    , bytestring      >= 0.11
-    , parsec          >= 3.1
-    , vector          >= 0.12

src/FWL/AST.hs

@@ -1,7 +1,6 @@
 module FWL.AST where
 
-import Data.Bits ((.&.), (.|.), shiftL, shiftR)
-import Data.Word (Word8)  -- Word8 still used for ByteElem/hex literals
+import Data.Word (Word8, Word16)
 
 type Name = String
 
@@ -28,7 +27,7 @@ data Decl
   | DLet        Name Type Expr
   | DPattern    Name Type Pat
   | DFlow       Name FlowExpr
-  | DRule       Name Type Expr
+  | DRule       Name Type Expr          -- body must be ELam
   | DPolicy     Name Type PolicyMeta ArmBlock
   deriving (Show)
 
@@ -42,22 +41,9 @@ data Hook      = HInput | HForward | HOutput | HPrerouting | HPostrouting
   deriving (Show, Eq)
 data TableName = TFilter | TNAT
   deriving (Show, Eq)
--- Priority is always an integer in the nftables JSON.
--- Named constants are resolved to their numeric values at parse time.
-newtype Priority = Priority { priorityValue :: Int }
+data Priority  = PFilter | PDstNat | PSrcNat | PMangle | PInt Int
   deriving (Show, Eq)
 
--- Standard nftables priority constants
-pRaw, pConnTrackDefrag, pConnTrack, pMangle, pDstNat, pFilter, pSecurity, pSrcNat :: Priority
-pRaw             = Priority (-300)
-pConnTrackDefrag = Priority (-400)
-pConnTrack       = Priority (-200)
-pMangle          = Priority (-150)
-pDstNat          = Priority (-100)
-pFilter          = Priority 0
-pSecurity        = Priority 50
-pSrcNat          = Priority 100
-
 data IfaceKind = IWan | ILan | IWireGuard | IUser Name
   deriving (Show)
 
@@ -67,27 +53,23 @@ data IfaceProp
   | IPCidr6 [CIDR]
   deriving (Show)
 
--- | A CIDR block: base address literal paired with prefix length.
--- e.g. (LIPv4 (10,0,0,0), 8) represents 10.0.0.0/8
-type CIDR = (Literal, Int)
-
 -- ─── Patterns ───────────────────────────────────────────────────────────────
 
 data Pat
   = PWild
   | PVar  Name
-  | PNamed Name
-  | PCtor  Name [Pat]
-  | PRecord Name [FieldPat]
+  | PNamed Name                          -- first-class named pattern ref
+  | PCtor  Name [Pat]                    -- IPv4(ip, ...), TCP(tcp, ...)
+  | PRecord Name [FieldPat]              -- udp { length = 156 }
   | PTuple [Pat]
-  | PFrame (Maybe PathPat) Pat
+  | PFrame (Maybe PathPat) Pat           -- Frame(path?, inner)
   | PBytes [ByteElem]
   deriving (Show)
 
 data FieldPat
-  = FPEq   Name Literal
-  | FPBind Name
-  | FPAs   Name Name
+  = FPEq   Name Literal                  -- field = literal
+  | FPBind Name                          -- bind field to same-named var
+  | FPAs   Name Name                     -- field as var
   deriving (Show)
 
 data PathPat  = PathPat (Maybe EndpointPat) (Maybe EndpointPat)
@@ -96,13 +78,13 @@ data PathPat  = PathPat (Maybe EndpointPat) (Maybe EndpointPat)
 data EndpointPat
   = EPWild
   | EPName   Name
-  | EPMember Name Name
+  | EPMember Name Name                   -- iif `in` zone
   deriving (Show)
 
 data ByteElem
   = BEHex  Word8
-  | BEWild
-  | BEWildStar
+  | BEWild                               -- _   (one byte)
+  | BEWildStar                           -- _*  (zero or more)
   deriving (Show)
 
 -- ─── Flow ───────────────────────────────────────────────────────────────────
@@ -113,11 +95,8 @@ data FlowExpr
   deriving (Show)
 
 type Duration = (Int, TimeUnit)
-
--- Fix 1: TimeUnit must derive Eq because Literal (which embeds it via
--- LDuration) derives Eq, requiring all constituent types to also have Eq.
 data TimeUnit = Seconds | Millis | Minutes | Hours
-  deriving (Show, Eq)
+  deriving (Show)
 
 -- ─── Types ──────────────────────────────────────────────────────────────────
 
@@ -132,7 +111,7 @@ data Type
 
 data Expr
   = EVar    Name
-  | EQual   [Name]
+  | EQual   [Name]                       -- qualified name, e.g. Log.emit
   | ELit    Literal
   | ELam    Name Expr
   | EApp    Expr Expr
@@ -143,7 +122,7 @@ data Expr
   | ETuple  [Expr]
   | ESet    [Expr]
   | EMap    [(Expr, Expr)]
-  | EPerform [Name] [Expr]
+  | EPerform [Name] [Expr]               -- perform QualName(args)
   | EInfix  InfixOp Expr Expr
   | ENot    Expr
   deriving (Show)
@@ -151,10 +130,10 @@ data Expr
 data InfixOp
   = OpAnd | OpOr
   | OpEq | OpNeq | OpLt | OpLte | OpGt | OpGte
-  | OpIn
-  | OpConcat
-  | OpThen
-  | OpBind
+  | OpIn                                 -- `in` / `∈`
+  | OpConcat                             -- ++
+  | OpThen                               -- >>
+  | OpBind                               -- >>=
   deriving (Show, Eq)
 
 data DoStmt
@@ -163,71 +142,19 @@ data DoStmt
   deriving (Show)
 
 type ArmBlock = [Arm]
-data Arm = Arm Pat (Maybe Expr) Expr
+data Arm = Arm Pat (Maybe Expr) Expr     -- pattern, guard?, body
   deriving (Show)
 
 -- ─── Literals ───────────────────────────────────────────────────────────────
 
--- IP addresses are stored as plain Integers for easy arithmetic,
--- CIDR validation (mask host bits), and future subnet math.
--- IPv4: 32-bit value in the low 32 bits.
--- IPv6: 128-bit value.
--- CIDR host-bit validation: (addr .&. hostMask prefix bits) == 0
-data IPVersion = IPv4 | IPv6
-  deriving (Show, Eq)
-
 data Literal
   = LInt      Int
   | LString   String
   | LBool     Bool
-  | LIP       IPVersion Integer   -- unified IP address representation
-  | LCIDR     Literal Int         -- base address + prefix length
+  | LIPv4     (Word8,Word8,Word8,Word8)
+  | LIPv6     [Word16]
+  | LCIDR     Literal Int
   | LPort     Int
   | LDuration Int TimeUnit
   | LHex      Word8
   deriving (Show, Eq)
-
--- ─── IP address helpers ──────────────────────────────────────────────────────
-
--- | Build an IPv4 literal from four octets.
-ipv4Lit :: Int -> Int -> Int -> Int -> Literal
-ipv4Lit a b c d =
-  LIP IPv4 (fromIntegral a `shiftL` 24
-          .|. fromIntegral b `shiftL` 16
-          .|. fromIntegral c `shiftL` 8
-          .|. fromIntegral d)
-
--- | Check that a CIDR has no host bits set.
-cidrHostBitsZero :: Integer -> Int -> Int -> Bool
-cidrHostBitsZero addr prefix bits =
-  let hostBits = bits - prefix
-      hostMask = (1 `shiftL` hostBits) - 1
-  in  (addr .&. hostMask) == 0
-
--- | Render an IPv4 integer as a dotted-decimal string.
-renderIPv4 :: Integer -> String
-renderIPv4 n =
-  show ((n `shiftR` 24) .&. 0xff) ++ "." ++
-  show ((n `shiftR` 16) .&. 0xff) ++ "." ++
-  show ((n `shiftR`  8) .&. 0xff) ++ "." ++
-  show  (n              .&. 0xff)
-
--- | Render an IPv6 integer as a condensed colon-hex string.
-renderIPv6 :: Integer -> String
-renderIPv6 n =
-  let groups = [ fromIntegral ((n `shiftR` (i * 16)) .&. 0xffff) :: Int
-               | i <- [7,6..0] ]
-      hexGroups = map (`showHex` "") groups
-  in  concatIntersperse ":" hexGroups
-  where
-    showHex x s = let h = showHexInt x in h ++ s
-    showHexInt x
-      | x == 0    = "0"
-      | otherwise = reverse (go x)
-      where go 0 = []
-            go v = let (q,r) = v `divMod` 16
-                       c     = "0123456789abcdef" !! r
-                   in  c : go q
-    concatIntersperse _ []     = ""
-    concatIntersperse _ [x]    = x
-    concatIntersperse s (x:xs) = x ++ s ++ concatIntersperse s xs

src/FWL/Check.hs

@@ -9,7 +9,7 @@ module FWL.Check
   , CheckError(..)
   ) where
 
-import Data.List (nub)
+import Data.List (foldl', nub)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 
@@ -43,12 +43,12 @@ buildEnv = foldl' addDecl Map.empty
   where
     addDecl m (DInterface n _ _) = Map.insert n KInterface m
     addDecl m (DZone n _)        = Map.insert n KZone m
-    addDecl m (DImport n _ _)    = Map.insert n KLet m
     addDecl m (DLet n _ _)       = Map.insert n KLet m
     addDecl m (DPattern n _ _)   = Map.insert n KPattern m
     addDecl m (DFlow n _)        = Map.insert n KFlow m
     addDecl m (DRule n _ _)      = Map.insert n KRule m
     addDecl m (DPolicy n _ _ _)  = Map.insert n KPolicy m
+    addDecl m _                  = m
 
 findDups :: [Decl] -> [CheckError]
 findDups decls = go [] Set.empty decls
@@ -100,12 +100,11 @@ checkName env kind n
 isBuiltin :: String -> Bool
 isBuiltin n = n `elem`
   [ "ct", "iif", "oif", "lo", "wan", "lan"
-  , "tcp", "udp", "ip", "ip6", "eth", "wg"
+  , "tcp", "udp", "ip", "ip6", "eth"
   , "Established", "Related", "DNAT"
-  , "Allow", "Drop", "Continue", "Masquerade", "DNATMap"
+  , "Allow", "Drop", "Continue", "Masquerade"
   , "Matched", "Unmatched"
   , "true", "false"
-  , "matches", "flowOf", "Warn"
   ]
 
 checkPat :: Env -> Pat -> [CheckError]
@@ -136,35 +135,15 @@ checkFlow env (FSeq a b _)   = checkFlow env a ++ checkFlow env b
 
 checkArm :: Env -> Arm -> [CheckError]
 checkArm env (Arm p mg e) =
-  let env' = addPat env p in
   checkPat env p ++
-  maybe [] (checkExpr env') mg ++
-  checkExpr env' e
-
-addPat :: Env -> Pat -> Env
-addPat env (PVar n)       = Map.insert n KLet env
-addPat env (PCtor _ ps)   = foldl' addPat env ps
-addPat env (PTuple ps)    = foldl' addPat env ps
-addPat env (PRecord _ fs) = foldl' addFP env fs
-addPat env (PFrame mp inner) =
-  let env' = case mp of
-        Just (PathPat ms md) ->
-          let env1 = case ms of Just (EPName n) -> Map.insert n KLet env; _ -> env
-          in case md of Just (EPName n) -> Map.insert n KLet env1; _ -> env1
-        Nothing -> env
-  in addPat env' inner
-addPat env _              = env
-
-addFP :: Env -> FieldPat -> Env
-addFP env (FPBind n) = Map.insert n KLet env
-addFP env (FPAs _ v) = Map.insert v KLet env
-addFP env _          = env
+  maybe [] (checkExpr env) mg ++
+  checkExpr env e
 
 checkExpr :: Env -> Expr -> [CheckError]
 checkExpr env (EVar n)         = checkName env "name" n
 checkExpr _   (EQual _)        = []   -- qualified names: deferred
 checkExpr _   (ELit _)         = []
-checkExpr env (ELam n e)       = checkExpr (Map.insert n KLet env) e
+checkExpr env (ELam _ e)       = checkExpr env e
 checkExpr env (EApp f x)       = checkExpr env f ++ checkExpr env x
 checkExpr env (ECase e ab)     = checkExpr env e ++ concatMap (checkArm env) ab
 checkExpr env (EIf c t f)      = concatMap (checkExpr env) [c,t,f]

src/FWL/Compile.hs

@@ -1,8 +1,8 @@
-{-# LANGUAGE OverloadedStrings #-}
 {- | Compile a checked FWL program to nftables JSON using Aeson.
      All policies (Filter and NAT) go into one table named by Config.
      Layer stripping: Frame patterns that omit Ether compile identically
-     to those that include it.
+     to those that include it — the compiler inserts protocol matches
+     from whatever constructor the user wrote.
 -}
 module FWL.Compile
   ( compileProgram
@@ -12,40 +12,34 @@ module FWL.Compile
 import Data.List (intercalate)
 import Data.Maybe (mapMaybe)
 import qualified Data.Map.Strict as Map
-import Data.Aeson ((.=), Value(..), object, toJSON)
 import qualified Data.Aeson as A
-import qualified Data.Text as T
+import Data.Aeson ((.=), Value(..), object, toJSON)
+import qualified Data.Aeson.Key as K
 import qualified Data.ByteString.Lazy as BL
-import Data.Aeson.Encode.Pretty (encodePretty)
+import qualified Data.Aeson.Encode.Pretty as Pretty
 
 import FWL.AST
 
 -- ─── Entry points ────────────────────────────────────────────────────────────
 
+-- | Compile an FWL program and render to pretty-printed JSON bytes.
 compileToJson :: Program -> BL.ByteString
-compileToJson = encodePretty . programToValue
-
--- exposed for tests
-compileProgram :: Program -> Value
-compileProgram = programToValue
+compileToJson = Pretty.encodePretty . programToValue
 
+-- | Compile an FWL program to an Aeson Value (the nftables JSON schema).
 programToValue :: Program -> Value
-programToValue (Program cfg decls) =
-  object [ "nftables" .= toJSON
-    (metainfo : tableObj : chainObjs ++ mapObjs ++ ruleObjs) ]
+programToValue prog@(Program cfg decls) =
+  object [ "nftables" .= toJSON (metainfo : tableObj : chainObjs ++ mapObjs ++ ruleObjs) ]
   where
     env       = buildEnv decls
     tbl       = configTable cfg
 
-    metainfo  = object [ "metainfo" .= object
-                  [ "json_schema_version" .= (1 :: Int) ] ]
+    metainfo  = object [ "metainfo" .= object [ "json_schema_version" .= (1 :: Int) ] ]
     tableObj  = object [ "table"    .= tableValue tbl ]
 
     policies  = [ (n, pm, ab) | DPolicy n _ pm ab <- decls ]
     chainObjs = map (\(n, pm, _)  -> chainDeclValue tbl n pm) policies
-    ruleObjs  = concatMap
-                  (\(n, _, ab) -> concatMap (armToRuleValues env tbl n) ab)
-                  policies
+    ruleObjs  = concatMap (\(n, _, ab) -> concatMap (armToRuleValues env tbl n) ab) policies
 
     letDecls  = [ (n, t, e) | DLet n t e <- decls ]
     mapObjs   = mapMaybe (\(n, _, e) -> letToMapValue tbl n e) letDecls
@@ -66,7 +60,7 @@ chainDeclValue tbl n pm = object
       , "name"     .= n
       , "type"     .= chainTypeStr (pmTable pm)
       , "hook"     .= hookStr (pmHook pm)
-      , "prio"     .= priorityInt (pmPriority pm)
+      , "prio"     .= priorityStr (pmPriority pm)
       , "policy"   .= defaultPolicyStr (pmHook pm)
       ]
   ]
@@ -82,10 +76,14 @@ hookStr HOutput      = "output"
 hookStr HPrerouting  = "prerouting"
 hookStr HPostrouting = "postrouting"
 
--- Priority is emitted as an integer in nftables JSON.
-priorityInt :: Priority -> Int
-priorityInt = priorityValue
+priorityStr :: Priority -> String
+priorityStr PFilter  = "filter"
+priorityStr PDstNat  = "dstnat"
+priorityStr PSrcNat  = "srcnat"
+priorityStr PMangle  = "mangle"
+priorityStr (PInt n) = show n
 
+-- Input and Forward hooks default to drop; everything else to accept.
 defaultPolicyStr :: Hook -> String
 defaultPolicyStr HInput   = "drop"
 defaultPolicyStr HForward = "drop"
@@ -93,10 +91,12 @@ defaultPolicyStr _        = "accept"
 
 -- ─── Arm → Rule objects ──────────────────────────────────────────────────────
 
+-- Each policy arm becomes zero or more nftables rule objects.
+-- An arm whose action is Continue compiles to zero rules.
 armToRuleValues :: CompileEnv -> String -> Name -> Arm -> [Value]
 armToRuleValues env tbl chain (Arm p mg body) =
   case compileAction env body of
-    Nothing      -> []
+    Nothing      -> []   -- Continue: emit nothing
     Just verdict ->
       let patExprs   = compilePat env p
           guardExprs = maybe [] (compileGuard env) mg
@@ -136,17 +136,21 @@ compilePat env (PFrame mp inner) =
 compilePat env (PCtor n ps)      = compileCtorPat env n ps
 compilePat _   (PRecord n fs)    = compileRecordPat n fs
 compilePat env (PTuple ps)       = concatMap (compilePat env) ps
-compilePat _   (PBytes _)        = []
+compilePat _   (PBytes _)        = []   -- handled by flow/ct mark (future)
 
+-- Named patterns are inlined at compile time.
 expandNamedPat :: CompileEnv -> Name -> [Value]
 expandNamedPat env n =
   case Map.lookup n env of
     Just (DPattern _ _ p) -> compilePat env p
     _                     -> []
 
+-- Layer stripping: Ether is transparent; IPv4/IPv6/TCP/UDP/ICMPv6 each emit
+-- the appropriate protocol-selector match then recurse into their children.
+-- Omitting Ether produces identical output.
 compileCtorPat :: CompileEnv -> String -> [Pat] -> [Value]
 compileCtorPat env ctor ps = case ctor of
-  "Ether"  -> children
+  "Ether"  -> children                           -- transparent layer
   "IPv4"   -> matchMeta "nfproto" "ipv4"   : children
   "IPv6"   -> matchMeta "nfproto" "ipv6"   : children
   "TCP"    -> matchPayload "th" "protocol" "tcp"   : children
@@ -157,12 +161,14 @@ compileCtorPat env ctor ps = case ctor of
   where
     children = concatMap (compilePat env) ps
 
+-- Record patterns emit field equality matches, e.g. tcp { dport = :22 }.
 compileRecordPat :: String -> [FieldPat] -> [Value]
 compileRecordPat proto = mapMaybe go
   where
     go (FPEq field lit) = Just (matchPayload proto field (renderLit lit))
     go _                = Nothing
 
+-- Path patterns (iif/oif).
 compilePathPat :: CompileEnv -> PathPat -> [Value]
 compilePathPat _ (PathPat ms md) =
   maybe [] (compileEndpoint "iifname") ms ++
@@ -172,6 +178,8 @@ compileEndpoint :: String -> EndpointPat -> [Value]
 compileEndpoint _   EPWild          = []
 compileEndpoint dir (EPName n)      = [matchMeta dir n]
 compileEndpoint dir (EPMember _ z)  = [matchInSet (metaVal dir) [z]]
+  -- zone membership: for MVP we emit the zone name as a set element.
+  -- A later pass would expand zones to their member interface names.
 
 -- ─── Guard → [Value] ─────────────────────────────────────────────────────────
 
@@ -183,21 +191,19 @@ compileGuard _   (EInfix OpNeq l r)  = [matchExpr "!=" (exprVal l) (exprVal r)]
 compileGuard _   _                    = []
 
 compileInExpr :: Expr -> Expr -> Value
--- Fix 4: put the more-specific ct patterns BEFORE the generic 2-element
--- EQual case to eliminate the overlapping pattern match warning.
+-- ct.state in { Established, Related }
 compileInExpr (EQual ["ct","state"])  (ESet vs) = ctMatch "state"  vs
 compileInExpr (EQual ["ct","status"]) (ESet vs) = ctMatch "status" vs
-compileInExpr l                        (ESet vs)  =
-  matchExpr "in" (exprVal l) (setVal (map exprToStr vs))
-compileInExpr l                        r          =
-  matchExpr "==" (exprVal l) (exprVal r)
+-- generic set membership
+compileInExpr l (ESet vs) = matchExpr "in" (exprVal l) (setVal (map exprToStr vs))
+compileInExpr l r         = matchExpr "==" (exprVal l) (exprVal r)
 
 ctMatch :: String -> [Expr] -> Value
 ctMatch key vs = matchExpr "in"
-  (object ["ct" .= object ["key" .= (key :: String)]])
+  (object ["ct" .= object ["key" .= key]])
   (setVal (map exprToStr vs))
 
--- ─── Action → Maybe Value ─────────────────────────────────────────────────────
+-- ─── Action → Maybe Value (Nothing = Continue = no rule) ─────────────────────
 
 compileAction :: CompileEnv -> Expr -> Maybe Value
 compileAction _   (EVar "Allow")      = Just (object ["accept"     .= Null])
@@ -210,6 +216,7 @@ compileAction _   (EApp (EVar "DNATMap") arg) =
   Just $ object ["dnat" .= object ["addr" .= object
     ["map" .= object ["key" .= object ["concat" .= Array mempty]
                      ,"data" .= exprToStr arg]]]]
+-- Rule invocation → jump
 compileAction env (EApp (EVar rn) _) =
   case Map.lookup rn env of
     Just (DRule _ _ _) -> Just $ object ["jump" .= object ["target" .= rn]]
@@ -234,54 +241,51 @@ letToMapValue _ _ _ = Nothing
 renderMapElem :: (Expr, Expr) -> Value
 renderMapElem (k, v) = toJSON
   [ object ["concat" .= toJSON [exprToStr k]]
-  , A.String (toText (exprToStr v))
+  , exprToStr v
   ]
 
 -- ─── Aeson building blocks ───────────────────────────────────────────────────
 
+-- { "match": { "op": op, "left": left, "right": right } }
 matchExpr :: String -> Value -> Value -> Value
 matchExpr op l r = object
   [ "match" .= object
-      [ "op"    .= (op :: String)
+      [ "op"    .= op
       , "left"  .= l
       , "right" .= r
       ]
   ]
 
 matchMeta :: String -> String -> Value
-matchMeta key val = matchExpr "==" (metaVal key) (A.String (toText val))
+matchMeta key val = matchExpr "==" (metaVal key) (A.String (strText val))
 
 matchPayload :: String -> String -> String -> Value
 matchPayload proto field val =
-  matchExpr "==" (payloadVal proto field) (A.String (toText val))
+  matchExpr "==" (payloadVal proto field) (A.String (strText val))
 
 matchInSet :: Value -> [String] -> Value
-matchInSet lhs vals = matchExpr "in" lhs (setVal vals)
+matchInSet lhs vals =
+  matchExpr "in" lhs (setVal vals)
 
 metaVal :: String -> Value
-metaVal key = object ["meta" .= object ["key" .= (key :: String)]]
+metaVal key = object ["meta" .= object ["key" .= key]]
 
 payloadVal :: String -> String -> Value
 payloadVal proto field =
-  object ["payload" .= object
-    [ "protocol" .= (proto :: String)
-    , "field"    .= (field :: String)
-    ]]
+  object ["payload" .= object ["protocol" .= proto, "field" .= field]]
 
 setVal :: [String] -> Value
 setVal vs = object ["set" .= toJSON vs]
 
--- ─── Expression helpers ───────────────────────────────────────────────────────
+-- ─── Expression → Value helpers ──────────────────────────────────────────────
 
--- Fix 3 (overlap): specific ct pattern first, generic 2-element case second.
 exprVal :: Expr -> Value
-exprVal (EQual ["ct", k])  = object ["ct" .= object ["key" .= (k :: String)]]
 exprVal (EQual [p, f])          = payloadVal p f
-exprVal (EQual ns)         = A.String (toText (intercalate "." ns))
+exprVal (EQual ["ct", k])       = object ["ct" .= object ["key" .= k]]
 exprVal (EVar n)                = metaVal n
-exprVal (ELit l)           = A.String (toText (renderLit l))
+exprVal (ELit l)                = A.String (strText (renderLit l))
 exprVal (ESet vs)               = setVal (map exprToStr vs)
-exprVal e                  = A.String (toText (exprToStr e))
+exprVal e                       = A.String (strText (exprToStr e))
 
 exprToStr :: Expr -> String
 exprToStr (EVar n)    = n
@@ -290,23 +294,23 @@ exprToStr (EQual ns)  = intercalate "." ns
 exprToStr (ETuple es) = intercalate " . " (map exprToStr es)
 exprToStr _           = "_"
 
--- Fix 2: Use Data.Text.pack via OverloadedStrings + fromString instead of
--- the fragile read(show s) hack. With OverloadedStrings enabled, string
--- literals already produce the correct Text/Key types; for runtime String
-toText :: String -> T.Text
-toText = T.pack
+strText :: String -> A.Text
+strText = \s -> read (show s)   -- simple String→Text without extra dep
 
 renderLit :: Literal -> String
 renderLit (LInt n)             = show n
 renderLit (LString s)          = s
 renderLit (LBool True)         = "true"
 renderLit (LBool False)        = "false"
-renderLit (LIP IPv4 n)          = renderIPv4 n
-renderLit (LIP IPv6 n)          = renderIPv6 n
+renderLit (LIPv4 (a,b,c,d))    =
+  show a++"."++show b++"."++show c++"."++show d
+renderLit (LIPv6 _)             = "::1"
 renderLit (LCIDR ip p)          = renderLit ip ++ "/" ++ show p
 renderLit (LPort p)             = show p
-renderLit (LDuration n Seconds) = show n ++ "s"
-renderLit (LDuration n Millis)  = show n ++ "ms"
-renderLit (LDuration n Minutes) = show n ++ "m"
-renderLit (LDuration n Hours)   = show n ++ "h"
+renderLit (LDuration n Seconds) = show n
+renderLit (LDuration n _)       = show n
 renderLit (LHex b)              = show b
+
+-- Data.Aeson.Key helper (aeson >= 2.0 uses Key, not Text, for object keys)
+(.=) :: A.ToJSON v => String -> v -> A.Pair
+k .= v = (K.fromString k, toJSON v)

src/FWL/Lexer.hs

@@ -15,11 +15,6 @@ fwlDef = emptyDef
   , Tok.identStart      = letter <|> char '_'
   , Tok.identLetter     = alphaNum <|> char '_'
   , Tok.reservedNames   =
-      -- Only genuine syntactic keywords belong here.
-      -- Semantic values used as constructors, actions, type names, or
-      -- pattern references (Allow, Drop, Log, Matched, Frame, etc.) must
-      -- NOT be reserved so that `identifier` can consume them in those
-      -- positions.
       [ "config", "table"
       , "interface", "zone", "import", "from"
       , "let", "in", "pattern", "flow", "rule", "policy", "on"
@@ -28,7 +23,11 @@ fwlDef = emptyDef
       , "hook", "priority"
       , "WAN", "LAN", "WireGuard"
       , "Input", "Forward", "Output", "Prerouting", "Postrouting"
-      , "Filter", "NAT", "Mangle", "DstNat", "SrcNat", "Raw", "ConnTrack"
+      , "Filter", "NAT", "Mangle", "DstNat", "SrcNat"
+      , "Allow", "Drop", "Continue", "Masquerade", "DNAT", "DNATMap"
+      , "Log", "Info", "Warn", "Error"
+      , "Matched", "Unmatched"
+      , "Frame", "FlowPattern"
       , "true", "false"
       ]
   , Tok.reservedOpNames =

src/FWL/Parser.hs

@@ -3,19 +3,15 @@ module FWL.Parser
   , parseFile
   ) where
 
-import Control.Monad (void, when)
-import Data.Bits ((.&.), (.|.), shiftL)
-import Data.List (foldl')
+import Control.Monad (void)
 import Data.Word (Word8)
 import Numeric (readHex)
 import Text.Parsec
 import Text.Parsec.String (Parser)
-import Data.Functor.Identity (Identity)
 import qualified Text.Parsec.Expr as Ex
 
 import FWL.AST
 import FWL.Lexer
-import Data.Char (isUpper)
 
 -- ─── Entry points ────────────────────────────────────────────────────────────
 
@@ -38,7 +34,7 @@ program = do
 configBlock :: Parser Config
 configBlock = do
   reserved "config"
-  props <- braces (endBy configProp semi)
+  props <- braces (semiSep configProp)
   optional semi
   return $ foldr applyProp defaultConfig props
   where
@@ -70,8 +66,8 @@ interfaceDecl = do
   n  <- identifier
   reservedOp ":"
   k  <- ifaceKind
-  ps <- braces (endBy ifaceProp semi)
-  _ <- semi
+  ps <- braces (semiSep ifaceProp)
+  semi
   return (DInterface n k ps)
 
 ifaceKind :: Parser IfaceKind
@@ -94,7 +90,7 @@ zoneDecl = do
   n  <- identifier
   reservedOp "="
   ns <- braces (commaSep1 identifier)
-  _ <- semi
+  semi
   return (DZone n ns)
 
 importDecl :: Parser Decl
@@ -105,7 +101,7 @@ importDecl = do
   t <- typeP
   reserved "from"
   s <- stringLit
-  _ <- semi
+  semi
   return (DImport n t s)
 
 letDecl :: Parser Decl
@@ -116,7 +112,7 @@ letDecl = do
   t <- typeP
   reservedOp "="
   e <- expr
-  _ <- semi
+  semi
   return (DLet n t e)
 
 patternDecl :: Parser Decl
@@ -127,7 +123,7 @@ patternDecl = do
   t <- typeP
   reservedOp "="
   p <- pat
-  _ <- semi
+  semi
   return (DPattern n t p)
 
 flowDecl :: Parser Decl
@@ -138,7 +134,7 @@ flowDecl = do
   reserved "FlowPattern"
   reservedOp "="
   f <- flowExpr
-  _ <- semi
+  semi
   return (DFlow n f)
 
 ruleDecl :: Parser Decl
@@ -149,7 +145,7 @@ ruleDecl = do
   t <- typeP
   reservedOp "="
   e <- expr
-  _ <- semi
+  semi
   return (DRule n t e)
 
 policyDecl :: Parser Decl
@@ -162,7 +158,7 @@ policyDecl = do
   pm <- braces policyMeta
   reservedOp "="
   ab <- armBlock
-  _ <- semi
+  semi
   return (DPolicy n t pm ab)
 
 policyMeta :: Parser PolicyMeta
@@ -170,7 +166,7 @@ policyMeta = do
   props <- commaSep1 metaProp
   let h  = foldr (\p a -> case p of Left  v -> v; _ -> a) HInput  props
       tb = foldr (\p a -> case p of Right (Left  v) -> v; _ -> a) TFilter props
-      pr = foldr (\p a -> case p of Right (Right v) -> v; _ -> a) pFilter props
+      pr = foldr (\p a -> case p of Right (Right v) -> v; _ -> a) PFilter props
   return (PolicyMeta h tb pr)
 
 metaProp :: Parser (Either Hook (Either TableName Priority))
@@ -191,21 +187,11 @@ tableNameP =  (reserved "Filter" >> return TFilter)
           <|> (reserved "NAT"    >> return TNAT)
 
 priorityP :: Parser Priority
-priorityP
-  =  (reserved "Filter"  >> return pFilter)
- <|> (reserved "DstNat"  >> return pDstNat)
- <|> (reserved "SrcNat"  >> return pSrcNat)
- <|> (reserved "Mangle"  >> return pMangle)
- <|> (reserved "Raw"     >> return pRaw)
- <|> (reserved "ConnTrack" >> return pConnTrack)
- <|> (Priority . fromIntegral <$> integerP)
-  where
-    -- Accept optional leading minus for negative priorities
-    integerP = do
-      neg <- option 1 (char '-' >> return (-1))
-      n   <- natural
-      whiteSpace
-      return (neg * fromIntegral n)
+priorityP =  (reserved "Filter" >> return PFilter)
+         <|> (reserved "DstNat" >> return PDstNat)
+         <|> (reserved "SrcNat" >> return PSrcNat)
+         <|> (reserved "Mangle" >> return PMangle)
+         <|> (PInt . fromIntegral <$> natural)
 
 -- ─── Arm blocks ──────────────────────────────────────────────────────────────
 
@@ -214,19 +200,19 @@ armBlock = braces (many arm)
 
 arm :: Parser Arm
 arm = do
-  _ <- symbol "|"
+  symbol "|"
   p  <- pat
   g  <- optionMaybe (reserved "if" >> expr)
   reservedOp "->"
   e  <- expr
-  _ <- semi
+  semi
   return (Arm p g e)
 
 -- ─── Patterns ────────────────────────────────────────────────────────────────
 
 pat :: Parser Pat
 pat =  wildcardPat
-   <|> try framePat
+   <|> framePat
    <|> try tuplePat
    <|> bytesPat
    <|> try recordPat
@@ -250,7 +236,7 @@ frameArgs = try withPath <|> withoutPath
   where
     withPath = do
       pp <- pathPat
-      _ <- comma
+      comma
       inner <- pat
       return (Just pp, inner)
     withoutPath = do
@@ -285,7 +271,7 @@ tuplePat = do
 commaSep2 :: Parser a -> Parser [a]
 commaSep2 p = do
   x  <- p
-  _ <- comma
+  comma
   xs <- commaSep1 p
   return (x:xs)
 
@@ -304,9 +290,8 @@ hexByte = do
   h1 <- hexDigit
   h2 <- hexDigit
   whiteSpace
-  case (readHex [h1,h2] :: [(Integer, String)]) of
-    [(v,"")] -> return (fromIntegral v)
-    _        -> fail "invalid hex byte"
+  let [(v,"")] = readHex [h1,h2]
+  return (fromIntegral v)
 
 -- Record pattern: ident { fields }
 recordPat :: Parser Pat
@@ -318,25 +303,17 @@ recordPat = do
 fieldPat :: Parser FieldPat
 fieldPat = do
   n <- identifier
-  try (reservedOp "=" >> FPEq n <$> fieldLiteral)
+  try (reservedOp "=" >> FPEq n <$> literal)
     <|> try (reserved "as" >> FPAs n <$> identifier)
     <|> return (FPBind n)
 
--- Port literals (:22) are valid in record field position as well as plain literals.
-fieldLiteral :: Parser Literal
-fieldLiteral = try portLit <|> literal
-  where
-    portLit = do
-      void (char ':')
-      n <- fromIntegral <$> natural
-      return (LPort n)
-
+-- Named pattern reference OR constructor: starts with uppercase-ish ident
 namedOrCtorPat :: Parser Pat
 namedOrCtorPat = do
   n  <- identifier
   args <- optionMaybe (try (parens (commaSep pat)))
   case args of
-    Nothing -> return $ if null n then PWild else if isUpper (head n) then PNamed n else PVar n
+    Nothing -> return (PNamed n)   -- bare name = named pattern ref
     Just ps -> return (PCtor  n ps)
 
 -- ─── Flow expressions ────────────────────────────────────────────────────────
@@ -346,17 +323,13 @@ flowExpr = do
   first <- FAtom <$> identifier
   rest  <- many (reservedOp "." >> identifier)
   mw    <- optionMaybe (reserved "within" >> durationLit)
-  let chain = buildSeq (first : map FAtom rest)
-  return $ case mw of
-    Nothing -> chain
-    Just w  -> attach w chain
+  return $ buildSeq (first : map FAtom rest) mw
   where
-    buildSeq [x]    = x
-    buildSeq (x:xs) = FSeq x (buildSeq xs) Nothing
-    buildSeq []     = error "impossible"
-
-    attach w (FSeq a b _) = FSeq a b (Just w)
-    attach w x            = FSeq x x (Just w)
+    buildSeq [x]    mw = case mw of
+                           Nothing -> x
+                           Just w  -> FSeq x x (Just w)  -- degenerate
+    buildSeq (x:xs) mw = FSeq x (buildSeq xs mw) mw
+    buildSeq []     _  = error "impossible"
 
 durationLit :: Parser Duration
 durationLit = do
@@ -545,7 +518,7 @@ mapEntry = do
 
 literal :: Parser Literal
 literal
-  =  try ipOrCidrLit
+  =  try cidrOrIpLit
  <|> try hexLit
  <|> try (LBool True  <$ reserved "true")
  <|> try (LBool False <$ reserved "false")
@@ -555,110 +528,26 @@ literal
 hexLit :: Parser Literal
 hexLit = LHex <$> hexByte
 
--- ─── IP / CIDR parsing ───────────────────────────────────────────────────────
-
--- | Parse an IPv4 or IPv6 address, optionally followed by /prefix.
--- Tries IPv6 first (it can start with hex digits too), then IPv4.
-ipOrCidrLit :: Parser Literal
-ipOrCidrLit = do
-  ip <- try ipv6Lit <|> ipv4Lit_
+cidrOrIpLit :: Parser Literal
+cidrOrIpLit = do
+  a <- fromIntegral <$> natural
+  void (char '.')
+  b <- fromIntegral <$> natural
+  void (char '.')
+  c <- fromIntegral <$> natural
+  void (char '.')
+  d <- fromIntegral <$> natural
+  whiteSpace
   mPrefix <- optionMaybe (char '/' >> fromIntegral <$> natural)
   whiteSpace
+  let ip = LIPv4 (a,b,c,d)
   return $ case mPrefix of
     Nothing -> ip
     Just p  -> LCIDR ip p
 
--- | IPv4: four decimal octets separated by dots → LIP IPv4 (32-bit Integer)
-ipv4Lit_ :: Parser Literal
-ipv4Lit_ = do
-  a <- octet
-  void (char '.')
-  b <- octet
-  void (char '.')
-  c <- octet
-  void (char '.')
-  d <- octet
-  return $ LIP IPv4
-    (  fromIntegral a `shiftL` 24
-   .|. fromIntegral b `shiftL` 16
-   .|. fromIntegral c `shiftL` 8
-   .|. fromIntegral d)
-  where
-    octet = do
-      n <- fromIntegral <$> natural
-      if n > 255 then fail "octet out of range" else return n
-
--- | IPv6: full notation, :: abbreviation, and optional embedded IPv4.
--- Stores as LIP IPv6 (128-bit Integer).
-ipv6Lit :: Parser Literal
-ipv6Lit = do
-  (left, hasDbl, right) <- ipv6Groups
-  let missing   = 8 - length left - length right
-  when (missing < 0) $ fail "too many groups in IPv6 address"
-  when (not hasDbl && missing /= 0) $ fail "invalid IPv6 address (must have 8 groups or use ::)"
-  let groups    = left ++ replicate missing 0 ++ right
-  when (length groups /= 8) $ fail "invalid IPv6 address"
-  let val = foldl' (\acc g -> (acc `shiftL` 16) .|. fromIntegral g) (0::Integer) groups
-  return (LIP IPv6 val)
-
--- Returns (left-of-::, has_dbl_colon, right-of-::).
--- If no :: present, left has all 8 groups and right is empty.
-ipv6Groups :: Parser ([Int], Bool, [Int])
-ipv6Groups = do
-  -- must start with a hex digit or ':' (for ::)
-  ahead <- lookAhead (hexDigit <|> char ':')
-  case ahead of
-    ':' -> do
-      void (string "::")
-      right <- ipv6RightGroups
-      return ([], True, right)
-    _   -> do
-      left <- ipv6LeftGroups
-      mDbl <- optionMaybe (try (string "::"))
-      case mDbl of
-        Nothing -> return (left, False, [])
-        Just _  -> do
-          right <- ipv6RightGroups
-          return (left, True, right)
-
--- Parse a run of hex16:hex16:... stopping before :: or end
-ipv6LeftGroups :: Parser [Int]
-ipv6LeftGroups = do
-  first <- hex16
-  rest  <- many (try (char ':' >> notFollowedBy (char ':') >> hex16))
-  return (first : rest)
-
--- Parse groups to the right of ::, including optional embedded IPv4
-ipv6RightGroups :: Parser [Int]
-ipv6RightGroups = option [] $
-  try ipv4EmbeddedGroups <|> ipv6LeftGroups
-
--- IPv4-mapped groups: e.g. ffff:192.168.1.1 -> [0xffff, 0xc0a8, 0x0101]
-ipv4EmbeddedGroups :: Parser [Int]
-ipv4EmbeddedGroups = do
-  prefix <- many (try (hex16 <* char ':' <* lookAhead digit))
-  a <- octet_; void (char '.')
-  b <- octet_; void (char '.')
-  c <- octet_; void (char '.')
-  d <- octet_
-  let hi = (a `shiftL` 8) .|. b
-      lo = (c `shiftL` 8) .|. d
-  return (prefix ++ [hi, lo])
-  where
-    octet_ = do
-      n <- fromIntegral <$> natural
-      if n > 255 then fail "IPv4 octet out of range" else return n
-
-hex16 :: Parser Int
-hex16 = do
-  digits <- many1 hexDigit
-  case (reads ("0x" ++ digits)) :: [(Int,String)] of
-    [(v,"")] -> if v > 0xffff then fail "hex16 out of range" else return v
-    _        -> fail "invalid hex group"
-
 cidrLit :: Parser CIDR
 cidrLit = do
-  l <- ipOrCidrLit
+  l <- cidrOrIpLit
   case l of
     LCIDR ip p -> return (ip, p)
-    _          -> fail "expected CIDR notation (address/prefix)"
+    _          -> fail "expected CIDR notation"

src/FWL/Pretty.hs

@@ -49,6 +49,8 @@ prettyIfaceProp (IPCidr4 cs) = "cidr4 = { " ++ intercalate ", " (map prettyCidr
 prettyIfaceProp (IPCidr6 cs) = "cidr6 = { " ++ intercalate ", " (map prettyCidr cs) ++ " }"
 
 prettyCidr :: CIDR -> String
+prettyCidr (LIPv4 (a,b,c,d), p) =
+  show a ++ "." ++ show b ++ "." ++ show c ++ "." ++ show d ++ "/" ++ show p
 prettyCidr (ip, p) = prettyLit ip ++ "/" ++ show p
 
 prettyHook :: Hook -> String
@@ -63,7 +65,11 @@ prettyTable TFilter = "Filter"
 prettyTable TNAT    = "NAT"
 
 prettyPriority :: Priority -> String
-prettyPriority p = show (priorityValue p)
+prettyPriority PFilter = "Filter"
+prettyPriority PDstNat = "DstNat"
+prettyPriority PSrcNat = "SrcNat"
+prettyPriority PMangle = "Mangle"
+prettyPriority (PInt n)= show n
 
 prettyType :: Type -> String
 prettyType (TName n [])   = n
@@ -176,8 +182,9 @@ prettyLit (LInt n)           = show n
 prettyLit (LString s)        = "\"" ++ s ++ "\""
 prettyLit (LBool True)       = "true"
 prettyLit (LBool False)      = "false"
-prettyLit (LIP IPv4 n)       = renderIPv4 n
-prettyLit (LIP IPv6 n)       = renderIPv6 n
+prettyLit (LIPv4 (a,b,c,d))  =
+  show a ++ "." ++ show b ++ "." ++ show c ++ "." ++ show d
+prettyLit (LIPv6 _)          = "<ipv6>"
 prettyLit (LCIDR ip p)       = prettyLit ip ++ "/" ++ show p
 prettyLit (LPort p)          = ":" ++ show p
 prettyLit (LDuration n u)    = show n ++ prettyUnit u

test/CheckTests.hs

@@ -1,224 +0,0 @@
-module CheckTests (tests) where
-
-import Test.Tasty
-import Test.Tasty.HUnit
-
-import FWL.Check
-import FWL.Util
-
-tests :: TestTree
-tests = testGroup "Check"
-  [ undefinedNameTests
-  , duplicateTests
-  , policyTerminationTests
-  , patternCycleTests
-  , cleanProgramTests
-  ]
-
--- ─── Helper ──────────────────────────────────────────────────────────────────
-
-checkSrc :: String -> IO [CheckError]
-checkSrc src = do
-  p <- parseOk src
-  return (checkProgram p)
-
-assertNoErrors :: String -> IO ()
-assertNoErrors src = do
-  errs <- checkSrc src
-  case errs of
-    [] -> return ()
-    _  -> assertFailure ("Unexpected errors: " ++ show errs)
-
-assertHasError :: (CheckError -> Bool) -> String -> IO ()
-assertHasError p src = do
-  errs <- checkSrc src
-  if any p errs
-    then return ()
-    else assertFailure ("Expected error not found. Got: " ++ show errs)
-
-isUndefined :: String -> CheckError -> Bool
-isUndefined n (UndefinedName _ m) = m == n
-isUndefined _ _                   = False
-
-isDuplicate :: String -> CheckError -> Bool
-isDuplicate n (DuplicateDecl _ m) = m == n
-isDuplicate _ _                   = False
-
-isNoContinue :: String -> CheckError -> Bool
-isNoContinue n (PolicyNoContinue m) = m == n
-isNoContinue _ _                    = False
-
-isCycle :: CheckError -> Bool
-isCycle (PatternCycle _) = True
-isCycle _                = False
-
--- ─── Undefined name tests ────────────────────────────────────────────────────
-
-undefinedNameTests :: TestTree
-undefinedNameTests = testGroup "undefined names"
-  [ testCase "zone references unknown interface" $
-      assertHasError (isUndefined "ghost")
-        "zone bad_zone = { lan, ghost };"
-
-  , testCase "zone references known interface — no error" $
-      assertNoErrors
-        "interface lan : LAN {}; \
-        \zone good = { lan };"
-
-  , testCase "pattern references undefined named pattern" $
-      assertHasError (isUndefined "Undefined")
-        "pattern Bad : Frame = Frame(_, IPv4(ip, Undefined));"
-
-  , testCase "pattern references known named pattern — no error" $
-      assertNoErrors
-        "pattern WGInit : (UDPHeader,Bytes) = (udp { length = 156 }, [0x01 _*]); \
-        \pattern Compound : Frame = Frame(_, IPv4(ip, WGInit));"
-
-  , testCase "flow references undefined pattern" $
-      assertHasError (isUndefined "Ghost")
-        "flow Bad : FlowPattern = Ghost;"
-
-  , testCase "flow references known pattern — no error" $
-      assertNoErrors
-        "pattern P : T = udp { length = 1 }; \
-        \flow F : FlowPattern = P;"
-
-  , testCase "policy guard references undeclared zone" $
-      -- 'unknown_zone' not declared; check should flag it
-      assertHasError (isUndefined "unknown_zone")
-        "policy fwd : Frame \
-        \  on { hook = Forward, table = Filter, priority = Filter } \
-        \  = { | Frame(iif in unknown_zone -> wan, _) -> Allow; \
-        \      | _ -> Drop; \
-        \  };"
-
-  , testCase "policy references known zone — no error" $
-      assertNoErrors
-        "interface lan : LAN {}; \
-        \zone trusted = { lan }; \
-        \policy fwd : Frame \
-        \  on { hook = Forward, table = Filter, priority = Filter } \
-        \  = { | Frame(iif in trusted -> wan, _) -> Allow; \
-        \      | _ -> Drop; \
-        \  };"
-  ]
-
--- ─── Duplicate declaration tests ─────────────────────────────────────────────
-
-duplicateTests :: TestTree
-duplicateTests = testGroup "duplicates"
-  [ testCase "duplicate interface" $
-      assertHasError (isDuplicate "lan")
-        "interface lan : LAN {}; \
-        \interface lan : WAN {};"
-
-  , testCase "duplicate zone" $
-      assertHasError (isDuplicate "z")
-        "zone z = { a }; \
-        \zone z = { b };"
-
-  , testCase "duplicate pattern" $
-      assertHasError (isDuplicate "P")
-        "pattern P : T = udp { length = 1 }; \
-        \pattern P : T = udp { length = 2 };"
-
-  , testCase "duplicate policy" $
-      assertHasError (isDuplicate "input")
-        "policy input : Frame \
-        \  on { hook = Input, table = Filter, priority = Filter } \
-        \  = { | _ -> Allow; }; \
-        \policy input : Frame \
-        \  on { hook = Input, table = Filter, priority = Filter } \
-        \  = { | _ -> Drop; };"
-
-  , testCase "distinct names — no error" $
-      assertNoErrors
-        "interface lan : LAN {}; \
-        \interface wan : WAN { dynamic; }; \
-        \zone z = { lan };"
-  ]
-
--- ─── Policy termination tests ────────────────────────────────────────────────
-
-policyTerminationTests :: TestTree
-policyTerminationTests = testGroup "policy termination"
-  [ testCase "last arm is Continue — error" $
-      assertHasError (isNoContinue "bad_policy")
-        "policy bad_policy : Frame \
-        \  on { hook = Input, table = Filter, priority = Filter } \
-        \  = { | _ -> Continue; };"
-
-  , testCase "last arm is Drop — ok" $
-      assertNoErrors
-        "policy good : Frame \
-        \  on { hook = Input, table = Filter, priority = Filter } \
-        \  = { | _ if ct.state in { Established } -> Allow; \
-        \      | _ -> Drop; \
-        \  };"
-
-  , testCase "last arm is Allow — ok" $
-      assertNoErrors
-        "policy output : Frame \
-        \  on { hook = Output, table = Filter, priority = Filter } \
-        \  = { | _ -> Allow; };"
-
-  , testCase "Continue in non-last arm is fine" $
-      assertNoErrors
-        "rule r : Frame -> Action = \
-        \  \\f -> case f of { \
-        \    | Frame(_, IPv4(ip, _)) -> Continue; \
-        \    | _ -> Drop; \
-        \  };"
-
-  , testCase "empty policy body — error" $
-      assertHasError (isNoContinue "empty")
-        "policy empty : Frame \
-        \  on { hook = Output, table = Filter, priority = Filter } \
-        \  = {};"
-  ]
-
--- ─── Pattern cycle tests ─────────────────────────────────────────────────────
-
-patternCycleTests :: TestTree
-patternCycleTests = testGroup "pattern cycles"
-  [ testCase "direct self-reference — cycle error" $
-      assertHasError isCycle
-        "pattern Loop : T = Frame(_, Loop);"
-
-  , testCase "mutual cycle — cycle error" $
-      assertHasError isCycle
-        "pattern A : T = Frame(_, B); \
-        \pattern B : T = Frame(_, A);"
-
-  , testCase "linear chain — no cycle" $
-      assertNoErrors
-        "pattern Base : T = udp { length = 1 }; \
-        \pattern Mid  : T = Frame(_, Base); \
-        \pattern Top  : T = Frame(_, Mid);"
-  ]
-
--- ─── Clean full programs ──────────────────────────────────────────────────────
-
-cleanProgramTests :: TestTree
-cleanProgramTests = testGroup "clean programs"
-  [ testCase "minimal router skeleton" $
-      assertNoErrors
-        "interface wan : WAN { dynamic; }; \
-        \interface lan : LAN { cidr4 = { 10.17.1.0/24 }; }; \
-        \interface wg0 : WireGuard {}; \
-        \zone lan_zone = { lan, wg0 }; \
-        \policy input : Frame \
-        \  on { hook = Input, table = Filter, priority = Filter } \
-        \  = { | _ if ct.state in { Established, Related } -> Allow; \
-        \      | _ -> Drop; \
-        \  }; \
-        \policy output : Frame \
-        \  on { hook = Output, table = Filter, priority = Filter } \
-        \  = { | _ -> Allow; };"
-
-  , testCase "pattern and flow declarations" $
-      assertNoErrors
-        "pattern WGInit : (UDPHeader,Bytes) = (udp { length = 156 }, [0x01 _*]); \
-        \pattern WGResp : (UDPHeader,Bytes) = (udp { length = 100 }, [0x02 _*]); \
-        \flow WGHandshake : FlowPattern = WGInit . WGResp within 5s;"
-  ]

test/CompileTests.hs

@@ -1,384 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module CompileTests (tests) where
-
-import Test.Tasty
-import Test.Tasty.HUnit
-import qualified Data.Aeson as A
-import qualified Data.Aeson.Key as AK
-import qualified Data.Aeson.KeyMap as AKM
-import qualified Data.Vector as V
-import qualified Data.ByteString.Lazy.Char8 as BL8
-
-import FWL.AST
-import FWL.Compile
-import FWL.Util
-
-tests :: TestTree
-tests = testGroup "Compile"
-  [ jsonStructureTests
-  , chainTests
-  , ruleExprTests
-  , verdictTests
-  , layerStrippingTests
-  , continueTests
-  , configTests
-  ]
-
--- ─── Helpers ─────────────────────────────────────────────────────────────────
-
-compileToValue :: String -> IO A.Value
-compileToValue src = do
-  p <- parseOk src
-  case A.decode (compileToJson p) of
-    Nothing -> assertFailure "Compiled output is not valid JSON" >> undefined
-    Just v  -> return v
-
--- Navigate a Value by a list of string keys / numeric indices.
-at :: [String] -> A.Value -> Maybe A.Value
-at []     v                   = Just v
-at (k:ks) (A.Object o)        =
-  case AKM.lookup (AK.fromString k) o of
-    Nothing -> Nothing
-    Just v  -> at ks v
-at (k:ks) (A.Array arr)       =
-  case reads k of
-    [(i,"")] | i < V.length arr -> at ks (arr V.! i)
-    _                           -> Nothing
-at _ _ = Nothing
-
-nftArr :: A.Value -> IO [A.Value]
-nftArr v =
-  case at ["nftables"] v of
-    Just (A.Array arr) -> return (V.toList arr)
-    _                  -> assertFailure "Missing top-level 'nftables' array" >> undefined
-
-withKey :: String -> [A.Value] -> [A.Value]
-withKey k = filter (\v -> case at [k] v of Just _ -> True; _ -> False)
-
--- ─── JSON structure tests ────────────────────────────────────────────────────
-
-jsonStructureTests :: TestTree
-jsonStructureTests = testGroup "JSON structure"
-  [ testCase "output is valid JSON" $ do
-      _ <- compileToValue
-        "policy output : Frame \
-        \  on { hook = Output, table = Filter, priority = Filter } \
-        \  = { | _ -> Allow; };"
-      return ()
-
-  , testCase "top-level nftables array present" $ do
-      v <- compileToValue "policy output : Frame \
-        \  on { hook = Output, table = Filter, priority = Filter } \
-        \  = { | _ -> Allow; };"
-      _ <- nftArr v
-      return ()
-
-  , testCase "metainfo is first element" $ do
-      v <- compileToValue "policy output : Frame \
-        \  on { hook = Output, table = Filter, priority = Filter } \
-        \  = { | _ -> Allow; };"
-      arr <- nftArr v
-      case arr of
-        (first:_) -> case at ["metainfo"] first of
-          Just _  -> return ()
-          Nothing -> assertFailure "First element is not metainfo"
-        [] -> assertFailure "Empty nftables array"
-
-  , testCase "table object present" $ do
-      v <- compileToValue "policy output : Frame \
-        \  on { hook = Output, table = Filter, priority = Filter } \
-        \  = { | _ -> Allow; };"
-      arr <- nftArr v
-      assertBool "Expected at least one table object"
-        (not (null (withKey "table" arr)))
-
-  , testCase "default table name is fwl" $ do
-      v <- compileToValue "policy output : Frame \
-        \  on { hook = Output, table = Filter, priority = Filter } \
-        \  = { | _ -> Allow; };"
-      arr <- nftArr v
-      case withKey "table" arr of
-        (t:_) -> at ["table","name"] t @?= Just (A.String "fwl")
-        []    -> assertFailure "No table object"
-
-  , testCase "custom table name respected" $ do
-      v <- compileToValue
-        "config { table = \"custom\"; } \
-        \policy output : Frame \
-        \  on { hook = Output, table = Filter, priority = Filter } \
-        \  = { | _ -> Allow; };"
-      arr <- nftArr v
-      case withKey "table" arr of
-        (t:_) -> at ["table","name"] t @?= Just (A.String "custom")
-        []    -> assertFailure "No table object"
-  ]
-
--- ─── Chain declaration tests ─────────────────────────────────────────────────
-
-chainTests :: TestTree
-chainTests = testGroup "chain declarations"
-  [ testCase "filter input chain has correct hook" $ do
-      v <- compileToValue
-        "policy input : Frame \
-        \  on { hook = Input, table = Filter, priority = Filter } \
-        \  = { | _ -> Drop; };"
-      arr <- nftArr v
-      case withKey "chain" arr of
-        (c:_) -> at ["chain","hook"] c @?= Just (A.String "input")
-        []    -> assertFailure "No chain"
-
-  , testCase "filter chain type is filter" $ do
-      v <- compileToValue
-        "policy fwd : Frame \
-        \  on { hook = Forward, table = Filter, priority = Filter } \
-        \  = { | _ -> Drop; };"
-      arr <- nftArr v
-      case withKey "chain" arr of
-        (c:_) -> at ["chain","type"] c @?= Just (A.String "filter")
-        []    -> assertFailure "No chain"
-
-  , testCase "NAT chain type is nat" $ do
-      v <- compileToValue
-        "policy nat_post : Frame \
-        \  on { hook = Postrouting, table = NAT, priority = SrcNat } \
-        \  = { | _ -> Allow; };"
-      arr <- nftArr v
-      case withKey "chain" arr of
-        (c:_) -> at ["chain","type"] c @?= Just (A.String "nat")
-        []    -> assertFailure "No chain"
-
-  , testCase "input chain default policy is drop" $ do
-      v <- compileToValue
-        "policy input : Frame \
-        \  on { hook = Input, table = Filter, priority = Filter } \
-        \  = { | _ -> Drop; };"
-      arr <- nftArr v
-      case withKey "chain" arr of
-        (c:_) -> at ["chain","policy"] c @?= Just (A.String "drop")
-        []    -> assertFailure "No chain"
-
-  , testCase "output chain default policy is accept" $ do
-      v <- compileToValue
-        "policy output : Frame \
-        \  on { hook = Output, table = Filter, priority = Filter } \
-        \  = { | _ -> Allow; };"
-      arr <- nftArr v
-      case withKey "chain" arr of
-        (c:_) -> at ["chain","policy"] c @?= Just (A.String "accept")
-        []    -> assertFailure "No chain"
-
-  , testCase "chain name matches policy name" $ do
-      v <- compileToValue
-        "policy my_input : Frame \
-        \  on { hook = Input, table = Filter, priority = Filter } \
-        \  = { | _ -> Drop; };"
-      arr <- nftArr v
-      case withKey "chain" arr of
-        (c:_) -> at ["chain","name"] c @?= Just (A.String "my_input")
-        []    -> assertFailure "No chain"
-
-  , testCase "two policies produce two chains" $ do
-      v <- compileToValue
-        "policy input : Frame \
-        \  on { hook = Input, table = Filter, priority = Filter } \
-        \  = { | _ -> Drop; }; \
-        \policy output : Frame \
-        \  on { hook = Output, table = Filter, priority = Filter } \
-        \  = { | _ -> Allow; };"
-      arr <- nftArr v
-      length (withKey "chain" arr) @?= 2
-  ]
-
--- ─── Rule expression tests ───────────────────────────────────────────────────
-
-ruleExprs :: [A.Value] -> [A.Value]
-ruleExprs arr =
-  [ e | r  <- withKey "rule" arr
-      , Just (A.Array es) <- [at ["rule","expr"] r]
-      , e  <- V.toList es ]
-
-ruleExprTests :: TestTree
-ruleExprTests = testGroup "rule expressions"
-  [ testCase "two arms produce two rules" $ do
-      v <- compileToValue
-        "policy input : Frame \
-        \  on { hook = Input, table = Filter, priority = Filter } \
-        \  = { | _ if ct.state in { Established, Related } -> Allow; \
-        \      | _ -> Drop; \
-        \  };"
-      arr <- nftArr v
-      length (withKey "rule" arr) @?= 2
-
-  , testCase "arm without guard produces one rule" $ do
-      v <- compileToValue
-        "policy output : Frame \
-        \  on { hook = Output, table = Filter, priority = Filter } \
-        \  = { | _ -> Allow; };"
-      arr <- nftArr v
-      length (withKey "rule" arr) @?= 1
-
-  , testCase "rule expr array is present" $ do
-      v <- compileToValue
-        "policy output : Frame \
-        \  on { hook = Output, table = Filter, priority = Filter } \
-        \  = { | _ -> Allow; };"
-      arr <- nftArr v
-      case withKey "rule" arr of
-        (r:_) -> case at ["rule","expr"] r of
-          Just (A.Array _) -> return ()
-          _                -> assertFailure "Missing or non-array 'expr'"
-        [] -> assertFailure "No rule"
-
-  , testCase "IPv4 ctor emits nfproto match" $ do
-      v <- compileToValue
-        "policy input : Frame \
-        \  on { hook = Input, table = Filter, priority = Filter } \
-        \  = { | Frame(_, IPv4(ip, _)) -> Allow; \
-        \      | _ -> Drop; \
-        \  };"
-      arr <- nftArr v
-      let matches   = withKey "match" (ruleExprs arr)
-          hasNfp    = any (\m ->
-            at ["match","left","meta","key"] m == Just (A.String "nfproto"))
-            matches
-      assertBool "Expected nfproto match for IPv4 ctor" hasNfp
-
-  , testCase "record field pat emits payload match" $ do
-      v <- compileToValue
-        "policy input : Frame \
-        \  on { hook = Input, table = Filter, priority = Filter } \
-        \  = { | Frame(_, TCP(tcp { dport = :22 }, _)) -> Allow; \
-        \      | _ -> Drop; \
-        \  };"
-      arr <- nftArr v
-      let matches  = withKey "match" (ruleExprs arr)
-          hasPort  = any (\m ->
-            at ["match","right"] m == Just (A.String "22"))
-            matches
-      assertBool "Expected port 22 payload match" hasPort
-  ]
-
--- ─── Verdict tests ───────────────────────────────────────────────────────────
-
-allExprs :: [A.Value] -> [A.Value]
-allExprs arr =
-  concatMap (\r -> case at ["rule","expr"] r of
-    Just (A.Array es) -> V.toList es; _ -> [])
-  (withKey "rule" arr)
-
-verdictTests :: TestTree
-verdictTests = testGroup "verdicts"
-  [ testCase "Allow compiles to accept" $ do
-      v <- compileToValue
-        "policy output : Frame \
-        \  on { hook = Output, table = Filter, priority = Filter } \
-        \  = { | _ -> Allow; };"
-      arr <- nftArr v
-      assertBool "Expected accept verdict"
-        (not (null (withKey "accept" (allExprs arr))))
-
-  , testCase "Drop compiles to drop" $ do
-      v <- compileToValue
-        "policy input : Frame \
-        \  on { hook = Input, table = Filter, priority = Filter } \
-        \  = { | _ -> Drop; };"
-      arr <- nftArr v
-      assertBool "Expected drop verdict"
-        (not (null (withKey "drop" (allExprs arr))))
-
-  , testCase "Masquerade compiles to masquerade" $ do
-      v <- compileToValue
-        "policy nat_post : Frame \
-        \  on { hook = Postrouting, table = NAT, priority = SrcNat } \
-        \  = { | _ -> Masquerade; };"
-      arr <- nftArr v
-      assertBool "Expected masquerade verdict"
-        (not (null (withKey "masquerade" (allExprs arr))))
-
-  , testCase "rule call compiles to jump" $ do
-      v <- compileToValue
-        "rule blockAll : Frame -> Action = \\f -> case f of { | _ -> Drop; }; \
-        \policy fwd : Frame \
-        \  on { hook = Forward, table = Filter, priority = Filter } \
-        \  = { | frame -> blockAll(frame); };"
-      arr <- nftArr v
-      assertBool "Expected jump verdict for rule call"
-        (not (null (withKey "jump" (allExprs arr))))
-  ]
-
--- ─── Layer stripping tests ───────────────────────────────────────────────────
-
-layerStrippingTests :: TestTree
-layerStrippingTests = testGroup "layer stripping"
-  [ testCase "Frame with and without Ether both emit nfproto match" $ do
-      let withEther =
-            "policy p1 : Frame \
-            \  on { hook = Input, table = Filter, priority = Filter } \
-            \  = { | Frame(_, Ether(_, IPv4(ip, _))) -> Allow; \
-            \      | _ -> Drop; \
-            \  };"
-          withoutEther =
-            "policy p1 : Frame \
-            \  on { hook = Input, table = Filter, priority = Filter } \
-            \  = { | Frame(_, IPv4(ip, _)) -> Allow; \
-            \      | _ -> Drop; \
-            \  };"
-      v1 <- compileToValue withEther
-      v2 <- compileToValue withoutEther
-      arr1 <- nftArr v1
-      arr2 <- nftArr v2
-      let nfp arr = filter
-            (\m -> at ["match","left","meta","key"] m == Just (A.String "nfproto"))
-            (withKey "match" (ruleExprs arr))
-      assertBool "Both should produce nfproto matches"
-        (not (null (nfp arr1)) && not (null (nfp arr2)))
-  ]
-
--- ─── Continue tests ───────────────────────────────────────────────────────────
-
-continueTests :: TestTree
-continueTests = testGroup "Continue"
-  [ testCase "two terminal arms produce two rules" $ do
-      v <- compileToValue
-        "policy fwd : Frame \
-        \  on { hook = Forward, table = Filter, priority = Filter } \
-        \  = { | _ if ct.state in { Established } -> Allow; \
-        \      | _ -> Drop; \
-        \  };"
-      arr <- nftArr v
-      length (withKey "rule" arr) @?= 2
-
-  , testCase "non-Continue arms still produce rules" $ do
-      v <- compileToValue
-        "policy input : Frame \
-        \  on { hook = Input, table = Filter, priority = Filter } \
-        \  = { | _ if ct.state in { Established } -> Allow; \
-        \      | _ -> Drop; \
-        \  };"
-      arr <- nftArr v
-      assertBool "Should have rules for non-Continue arms"
-        (not (null (withKey "rule" arr)))
-  ]
-
--- ─── Config tests ─────────────────────────────────────────────────────────────
-
-configTests :: TestTree
-configTests = testGroup "config"
-  [ testCase "all rule objects reference correct table" $ do
-      v <- compileToValue
-        "policy input : Frame \
-        \  on { hook = Input, table = Filter, priority = Filter } \
-        \  = { | _ -> Drop; };"
-      arr <- nftArr v
-      mapM_ (\r -> at ["rule","table"] r @?= Just (A.String "fwl"))
-        (withKey "rule" arr)
-
-  , testCase "chain objects reference correct table" $ do
-      v <- compileToValue
-        "policy input : Frame \
-        \  on { hook = Input, table = Filter, priority = Filter } \
-        \  = { | _ -> Drop; };"
-      arr <- nftArr v
-      mapM_ (\c -> at ["chain","table"] c @?= Just (A.String "fwl"))
-        (withKey "chain" arr)
-  ]

test/FWL/Util.hs

@@ -1,44 +0,0 @@
--- | Shared test utilities.
-module FWL.Util where
-
-import Test.Tasty.HUnit
-import Text.Parsec.String (Parser)
-import Text.Parsec (parse)
-
-import FWL.Parser (parseProgram)
-import FWL.AST
-
--- | Assert a parser succeeds and return the result.
-shouldParse :: (Show a) => Parser a -> String -> IO a
-shouldParse p input =
-  case parse p "<test>" input of
-    Left err -> assertFailure ("Unexpected parse error:\n" ++ show err)
-                >> undefined
-    Right v  -> return v
-
--- | Assert a parser fails.
-shouldFailParse :: (Show a) => Parser a -> String -> IO ()
-shouldFailParse p input =
-  case parse p "<test>" input of
-    Left _  -> return ()
-    Right v -> assertFailure ("Expected parse failure but got: " ++ show v)
-
--- | Parse a full program, asserting success.
-parseOk :: String -> IO Program
-parseOk src =
-  case parseProgram "<test>" src of
-    Left err -> assertFailure ("Parse error:\n" ++ show err) >> undefined
-    Right p  -> return p
-
--- | Parse a full program, asserting failure.
-parseFail :: String -> IO ()
-parseFail src =
-  case parseProgram "<test>" src of
-    Left _  -> return ()
-    Right p -> assertFailure ("Expected parse failure, got:\n" ++ show p)
-
--- | Extract the single declaration from a one-decl program.
-singleDecl :: Program -> IO Decl
-singleDecl (Program _ [d]) = return d
-singleDecl (Program _ ds)  =
-  assertFailure ("Expected 1 decl, got " ++ show (length ds)) >> undefined

test/ParserTests.hs

@@ -1,516 +0,0 @@
-module ParserTests (tests) where
-
-import Test.Tasty
-import Test.Tasty.HUnit
-
-import FWL.AST
-import FWL.Util
-
-tests :: TestTree
-tests = testGroup "Parser"
-  [ interfaceTests
-  , zoneTests
-  , importTests
-  , letTests
-  , patternTests
-  , flowTests
-  , typeTests
-  , exprTests
-  , policyTests
-  , ruleTests
-  , configTests
-  , errorTests
-  ]
-
--- ─── Interface ───────────────────────────────────────────────────────────────
-
-interfaceTests :: TestTree
-interfaceTests = testGroup "interface"
-  [ testCase "WAN dynamic" $ do
-      p <- parseOk "interface wan : WAN { dynamic; };"
-      d <- singleDecl p
-      case d of
-        DInterface "wan" IWan [IPDynamic] -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "LAN with cidr4" $ do
-      p <- parseOk "interface lan : LAN { cidr4 = { 10.0.0.0/8 }; };"
-      d <- singleDecl p
-      case d of
-        DInterface "lan" ILan [IPCidr4 [(ip, 8)]] | ip == ipv4Lit 10 0 0 0 -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "LAN with cidr4 and cidr6" $ do
-      p <- parseOk
-            "interface lan : LAN { \
-            \  cidr4 = { 10.17.1.0/24 }; \
-            \  cidr6 = { 192.168.0.0/16 }; \
-            \};"
-      d <- singleDecl p
-      case d of
-        DInterface "lan" ILan [IPCidr4 _, IPCidr6 _] -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "WireGuard interface" $ do
-      p <- parseOk "interface wg0 : WireGuard {};"
-      d <- singleDecl p
-      case d of
-        DInterface "wg0" IWireGuard [] -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "user-defined kind" $ do
-      p <- parseOk "interface eth0 : Bridge {};"
-      d <- singleDecl p
-      case d of
-        DInterface "eth0" (IUser "Bridge") [] -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "multiple CIDRs in set" $ do
-      p <- parseOk
-            "interface lan : LAN { \
-            \  cidr4 = { 10.0.0.0/8, 172.16.0.0/12, 192.168.0.0/16 }; \
-            \};"
-      d <- singleDecl p
-      case d of
-        DInterface _ _ [IPCidr4 cidrs] -> length cidrs @?= 3
-        _ -> assertFailure (show d)
-  ]
-
--- ─── Zone ────────────────────────────────────────────────────────────────────
-
-zoneTests :: TestTree
-zoneTests = testGroup "zone"
-  [ testCase "single member" $ do
-      p <- parseOk "zone trusted = { lan };"
-      d <- singleDecl p
-      case d of
-        DZone "trusted" ["lan"] -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "multiple members" $ do
-      p <- parseOk "zone lan_zone = { lan, wg0, vlan10 };"
-      d <- singleDecl p
-      case d of
-        DZone "lan_zone" ["lan","wg0","vlan10"] -> return ()
-        _ -> assertFailure (show d)
-  ]
-
--- ─── Import ──────────────────────────────────────────────────────────────────
-
-importTests :: TestTree
-importTests = testGroup "import"
-  [ testCase "basic import" $ do
-      p <- parseOk "import rfc1918 : CIDRSet from \"builtin:rfc1918\";"
-      d <- singleDecl p
-      case d of
-        DImport "rfc1918" (TName "CIDRSet" []) "builtin:rfc1918" -> return ()
-        _ -> assertFailure (show d)
-  ]
-
--- ─── Let ─────────────────────────────────────────────────────────────────────
-
-letTests :: TestTree
-letTests = testGroup "let"
-  [ testCase "simple integer" $ do
-      p <- parseOk "let timeout : Int = 30;"
-      d <- singleDecl p
-      case d of
-        DLet "timeout" (TName "Int" []) (ELit (LInt 30)) -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "map literal" $ do
-      p <- parseOk
-            "let forwards : Map<(Protocol,Port),(IP,Port)> = { \
-            \  (tcp, :8080) -> (10.0.0.1, :80) \
-            \};"
-      d <- singleDecl p
-      case d of
-        DLet "forwards" _ (EMap [_]) -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "string literal" $ do
-      p <- parseOk "let name : String = \"hello\";"
-      d <- singleDecl p
-      case d of
-        DLet "name" _ (ELit (LString "hello")) -> return ()
-        _ -> assertFailure (show d)
-  ]
-
--- ─── Pattern ─────────────────────────────────────────────────────────────────
-
-patternTests :: TestTree
-patternTests = testGroup "pattern"
-  [ testCase "tuple with record field" $ do
-      p <- parseOk
-            "pattern WGInitiation : (UDPHeader, Bytes) = \
-            \  (udp { length = 156 }, [0x01 _*]);"
-      d <- singleDecl p
-      case d of
-        DPattern "WGInitiation" _ (PTuple [PRecord "udp" _, PBytes _]) -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "byte pattern elements" $ do
-      p <- parseOk
-            "pattern WGResponse : (UDPHeader, Bytes) = \
-            \  (udp { length = 100 }, [0x02 _ _*]);"
-      d <- singleDecl p
-      case d of
-        DPattern "WGResponse" _ (PTuple [_, PBytes [BEHex 0x02, BEWild, BEWildStar]]) ->
-          return ()
-        _ -> assertFailure (show d)
-
-  , testCase "named pattern reference in ctor" $ do
-      p <- parseOk
-            "pattern Complex : Frame = \
-            \  Frame(_, IPv4(ip, WGInitiation));"
-      d <- singleDecl p
-      case d of
-        DPattern "Complex" _ (PFrame (Just _) (PCtor "IPv4" [PVar "ip", PNamed "WGInitiation"])) ->
-          return ()
-        _ -> assertFailure (show d)
-
-  , testCase "record with field bind" $ do
-      p <- parseOk "pattern HasTCP : TCP = tcp { dport };"
-      d <- singleDecl p
-      case d of
-        DPattern "HasTCP" _ (PRecord "tcp" [FPBind "dport"]) -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "record with field equality" $ do
-      p <- parseOk "pattern SSH : TCP = tcp { dport = :22 };"
-      d <- singleDecl p
-      case d of
-        DPattern "SSH" _ (PRecord "tcp" [FPEq "dport" (LPort 22)]) -> return ()
-        _ -> assertFailure (show d)
-  ]
-
--- ─── Flow ────────────────────────────────────────────────────────────────────
-
-flowTests :: TestTree
-flowTests = testGroup "flow"
-  [ testCase "two-step sequence with within" $ do
-      p <- parseOk
-            "flow WireGuardHandshake : FlowPattern = \
-            \  WGInitiation . WGResponse within 5s;"
-      d <- singleDecl p
-      case d of
-        DFlow "WireGuardHandshake" (FSeq (FAtom "WGInitiation") (FAtom "WGResponse") (Just (5, Seconds))) ->
-          return ()
-        _ -> assertFailure (show d)
-
-  , testCase "single atom flow" $ do
-      p <- parseOk "flow Simple : FlowPattern = Ping;"
-      d <- singleDecl p
-      case d of
-        DFlow "Simple" (FAtom "Ping") -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "duration in milliseconds" $ do
-      p <- parseOk "flow Fast : FlowPattern = A . B within 500ms;"
-      d <- singleDecl p
-      case d of
-        DFlow "Fast" (FSeq _ _ (Just (500, Millis))) -> return ()
-        _ -> assertFailure (show d)
-  ]
-
--- ─── Types ───────────────────────────────────────────────────────────────────
-
-typeTests :: TestTree
-typeTests = testGroup "types"
-  [ testCase "simple name" $ do
-      p <- parseOk "let x : Frame = Allow;"
-      d <- singleDecl p
-      case d of
-        DLet _ (TName "Frame" []) _ -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "generic type" $ do
-      p <- parseOk "let x : Map<Int, String> = Allow;"
-      d <- singleDecl p
-      case d of
-        DLet _ (TName "Map" [TName "Int" [], TName "String" []]) _ -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "function type" $ do
-      p <- parseOk "let x : Frame -> Action = Allow;"
-      d <- singleDecl p
-      case d of
-        DLet _ (TFun (TName "Frame" []) (TName "Action" [])) _ -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "effect type" $ do
-      p <- parseOk "let x : <Log, FlowMatch> Action = Allow;"
-      d <- singleDecl p
-      case d of
-        DLet _ (TEffect ["Log","FlowMatch"] (TName "Action" [])) _ -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "tuple type" $ do
-      p <- parseOk "let x : (Int, String) = Allow;"
-      d <- singleDecl p
-      case d of
-        DLet _ (TTuple [TName "Int" [], TName "String" []]) _ -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "function with effects" $ do
-      p <- parseOk "let x : Frame -> <Log> Action = Allow;"
-      d <- singleDecl p
-      case d of
-        DLet _ (TFun _ (TEffect ["Log"] _)) _ -> return ()
-        _ -> assertFailure (show d)
-  ]
-
--- ─── Expressions ─────────────────────────────────────────────────────────────
-
-exprTests :: TestTree
-exprTests = testGroup "expressions"
-  [ testCase "boolean and" $ do
-      p <- parseOk "let x : Bool = a && b;"
-      d <- singleDecl p
-      case d of
-        DLet _ _ (EInfix OpAnd (EVar "a") (EVar "b")) -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "set membership with 'in'" $ do
-      p <- parseOk "let x : Bool = ct.state in { Established, Related };"
-      d <- singleDecl p
-      case d of
-        DLet _ _ (EInfix OpIn (EQual ["ct","state"]) (ESet _)) -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "equality comparison" $ do
-      p <- parseOk "let x : Bool = tcp.dport == :22;"
-      d <- singleDecl p
-      case d of
-        DLet _ _ (EInfix OpEq (EQual ["tcp","dport"]) (ELit (LPort 22))) -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "if-then-else" $ do
-      p <- parseOk "let x : Action = if a then Allow else Drop;"
-      d <- singleDecl p
-      case d of
-        DLet _ _ (EIf (EVar "a") (EVar "Allow") (EVar "Drop")) -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "perform expression" $ do
-      p <- parseOk "let x : Action = perform Log.emit(Info, \"msg\");"
-      d <- singleDecl p
-      case d of
-        DLet _ _ (EPerform ["Log","emit"] [ELit (LString "Info"), ELit (LString "msg")]) -> return ()
-        DLet _ _ (EPerform ["Log","emit"] _) -> return ()  -- arg parsing flexible
-        _ -> assertFailure (show d)
-
-  , testCase "do block" $ do
-      p <- parseOk "let x : Action = do { y <- foo; y };"
-      d <- singleDecl p
-      case d of
-        DLet _ _ (EDo [DSBind "y" _, DSExpr (EVar "y")]) -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "nested case" $ do
-      p <- parseOk
-            "let x : Action = case e of { \
-            \  | a -> Allow; \
-            \  | _ -> Drop; \
-            \};"
-      d <- singleDecl p
-      case d of
-        DLet _ _ (ECase (EVar "e") [Arm (PVar "a") Nothing _, Arm PWild Nothing _]) -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "lambda" $ do
-      p <- parseOk "let x : Frame -> Action = \\frame -> Allow;"
-      d <- singleDecl p
-      case d of
-        DLet _ _ (ELam "frame" (EVar "Allow")) -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "string concat" $ do
-      p <- parseOk "let x : String = \"hello\" ++ \" world\";"
-      d <- singleDecl p
-      case d of
-        DLet _ _ (EInfix OpConcat _ _) -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "negation" $ do
-      p <- parseOk "let x : Bool = !flag;"
-      d <- singleDecl p
-      case d of
-        DLet _ _ (ENot (EVar "flag")) -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "set literal" $ do
-      p <- parseOk "let x : Set<Int> = { 22, 80, 443 };"
-      d <- singleDecl p
-      case d of
-        DLet _ _ (ESet [ELit (LInt 22), ELit (LInt 80), ELit (LInt 443)]) -> return ()
-        _ -> assertFailure (show d)
-  ]
-
--- ─── Policy ──────────────────────────────────────────────────────────────────
-
-policyTests :: TestTree
-policyTests = testGroup "policy"
-  [ testCase "minimal policy" $ do
-      p <- parseOk
-            "policy output : Frame \
-            \  on { hook = Output, table = Filter, priority = Filter } \
-            \  = { | _ -> Allow; };"
-      d <- singleDecl p
-      case d of
-        DPolicy "output" _ (PolicyMeta HOutput TFilter (Priority 0)) [_] -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "NAT prerouting" $ do
-      p <- parseOk
-            "policy nat_pre : Frame \
-            \  on { hook = Prerouting, table = NAT, priority = DstNat } \
-            \  = { | _ -> Allow; };"
-      d <- singleDecl p
-      case d of
-        DPolicy _ _ (PolicyMeta HPrerouting TNAT (Priority (-100))) _ -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "arm with guard" $ do
-      p <- parseOk
-            "policy input : Frame \
-            \  on { hook = Input, table = Filter, priority = Filter } \
-            \  = { \
-            \    | _ if ct.state in { Established, Related } -> Allow; \
-            \    | _ -> Drop; \
-            \  };"
-      d <- singleDecl p
-      case d of
-        DPolicy _ _ _ [Arm PWild (Just _) _, Arm PWild Nothing _] -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "Frame pattern with path" $ do
-      p <- parseOk
-            "policy forward : Frame \
-            \  on { hook = Forward, table = Filter, priority = Filter } \
-            \  = { \
-            \    | Frame(iif in lan_zone -> wan, _) -> Allow; \
-            \    | _ -> Drop; \
-            \  };"
-      d <- singleDecl p
-      case d of
-        DPolicy _ _ _ (Arm (PFrame (Just _) _) Nothing _ : _) -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "Frame pattern without Ether (layer stripping)" $ do
-      p <- parseOk
-            "policy input : Frame \
-            \  on { hook = Input, table = Filter, priority = Filter } \
-            \  = { \
-            \    | Frame(_, IPv4(ip, TCP(tcp, _))) if tcp.dport == :22 -> Allow; \
-            \    | _ -> Drop; \
-            \  };"
-      d <- singleDecl p
-      case d of
-        DPolicy _ _ _ (Arm (PFrame (Just _) (PCtor "IPv4" _)) _ _ : _) -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "policy arm calls rule" $ do
-      p <- parseOk
-            "policy forward : Frame \
-            \  on { hook = Forward, table = Filter, priority = Filter } \
-            \  = { \
-            \    | frame -> blockOutboundWG(frame); \
-            \  };"
-      d <- singleDecl p
-      case d of
-        DPolicy _ _ _ [Arm (PVar "frame") Nothing (EApp (EVar "blockOutboundWG") _)] ->
-          return ()
-        _ -> assertFailure (show d)
-
-  , testCase "Continue arm is parsed" $ do
-      p <- parseOk
-            "rule r : Frame -> Action = \
-            \  \\frame -> case frame of { \
-            \    | _ -> Continue; \
-            \  };"
-      d <- singleDecl p
-      case d of
-        DRule _ _ _ -> return ()
-        _ -> assertFailure (show d)
-  ]
-
--- ─── Rule ────────────────────────────────────────────────────────────────────
-
-ruleTests :: TestTree
-ruleTests = testGroup "rule"
-  [ testCase "simple rule" $ do
-      p <- parseOk
-            "rule blockAll : Frame -> Action = \
-            \  \\frame -> case frame of { | _ -> Drop; };"
-      d <- singleDecl p
-      case d of
-        DRule "blockAll" _ (ELam "frame" (ECase _ _)) -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "rule with effects in type" $ do
-      p <- parseOk
-            "rule logged : Frame -> <Log> Action = \
-            \  \\f -> case f of { | _ -> Allow; };"
-      d <- singleDecl p
-      case d of
-        DRule "logged" (TFun _ (TEffect ["Log"] _)) _ -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "nested case in rule" $ do
-      p <- parseOk
-            "rule check : Frame -> <FlowMatch> Action = \
-            \  \\frame -> \
-            \    case frame of { \
-            \      | Frame(_, IPv4(ip, UDP(udp, _))) -> \
-            \          case perform FlowMatch.check(ip, wg) of { \
-            \            | Matched -> Drop; \
-            \            | _ -> Continue; \
-            \          }; \
-            \      | _ -> Continue; \
-            \    };"
-      d <- singleDecl p
-      case d of
-        DRule "check" _ (ELam _ (ECase _ _)) -> return ()
-        _ -> assertFailure (show d)
-  ]
-
--- ─── Config ──────────────────────────────────────────────────────────────────
-
-configTests :: TestTree
-configTests = testGroup "config"
-  [ testCase "default table name" $ do
-      p <- parseOk "interface wan : WAN {};"
-      configTable (progConfig p) @?= "fwl"
-
-  , testCase "custom table name" $ do
-      p <- parseOk "config { table = \"myrules\"; } interface wan : WAN {};"
-      configTable (progConfig p) @?= "myrules"
-  ]
-
--- ─── Error cases ─────────────────────────────────────────────────────────────
-
-errorTests :: TestTree
-errorTests = testGroup "parse errors"
-  [ testCase "missing semicolon" $
-      parseFail "interface wan : WAN {}"
-
-  , testCase "unknown hook" $
-      parseFail
-        "policy p : Frame \
-        \  on { hook = Bogus, table = Filter, priority = Filter } \
-        \  = { | _ -> Allow; };"
-
-  , testCase "empty arm block with no arms is ok" $ do
-      p <- parseOk
-            "policy output : Frame \
-            \  on { hook = Output, table = Filter, priority = Filter } \
-            \  = {};"
-      d <- singleDecl p
-      case d of
-        DPolicy _ _ _ [] -> return ()
-        _ -> assertFailure (show d)
-
-  , testCase "CIDR without prefix fails" $
-      parseFail "interface lan : LAN { cidr4 = { 10.0.0.1 }; };"
-  ]

test/Spec.hs

@@ -1,15 +0,0 @@
-module Main where
-
-import Test.Tasty
-import Test.Tasty.HUnit
-
-import qualified ParserTests
-import qualified CheckTests
-import qualified CompileTests
-
-main :: IO ()
-main = defaultMain $ testGroup "FWL"
-  [ ParserTests.tests
-  , CheckTests.tests
-  , CompileTests.tests
-  ]