1  #!/usr/bin/env runghc
  2  {-# LANGUAGE OverloadedStrings #-}
  3  
  4  {- |
  5  Quick validation script for Aleph.Script tooling
  6  
  7  Run: runghc -i. check.hs
  8  
  9  Checks:
 10    1. All generated wrappers compile
 11    2. Parsers don't crash on corpus files
 12    3. Key invariants hold
 13  -}
 14  module Main where
 15  
 16  import Control.Monad (forM_, when)
 17  import Data.Text (Text)
 18  import qualified Data.Text as T
 19  import qualified Data.Text.IO as TIO
 20  import System.Directory (listDirectory)
 21  import System.Exit (ExitCode (..), exitFailure, exitSuccess)
 22  import System.Process (readProcessWithExitCode)
 23  
 24  import qualified Aleph.Script.Clap as Clap
 25  import qualified Aleph.Script.Getopt as Getopt
 26  
 27  main :: IO ()
 28  main = do
 29      putStrLn "=== Aleph.Script Validation ==="
 30      putStrLn ""
 31  
 32      -- Check 1: All wrappers compile
 33      putStr "Compiling all wrappers... "
 34      (exit, _, stderr) <-
 35          readProcessWithExitCode
 36              "ghc"
 37              ["-fno-code", "-i.", "Weyl/Script/Tools.hs"]
 38              ""
 39      case exit of
 40          ExitSuccess -> putStrLn "OK"
 41          ExitFailure _ -> do
 42              putStrLn "FAILED"
 43              putStrLn stderr
 44              exitFailure
 45  
 46      -- Check 2: Parse corpus files without crashing
 47      putStr "Parsing clap corpus... "
 48      clapFiles <- listDirectory "corpus"
 49      forM_ (filter (".txt" `isSuffixOf`) clapFiles) $ \f -> do
 50          content <- TIO.readFile ("corpus/" ++ f)
 51          let _ = Clap.parseHelp content
 52          return ()
 53      putStrLn $ "OK (" ++ show (length clapFiles) ++ " files)"
 54  
 55      putStr "Parsing GNU corpus... "
 56      gnuFiles <- listDirectory "corpus-gnu"
 57      forM_ (filter (".txt" `isSuffixOf`) gnuFiles) $ \f -> do
 58          content <- TIO.readFile ("corpus-gnu/" ++ f)
 59          let _ = Getopt.parseHelp content
 60          return ()
 61      putStrLn $ "OK (" ++ show (length gnuFiles) ++ " files)"
 62  
 63      -- Check 3: Generated code has required structure
 64      putStr "Checking generated structure... "
 65      let testInput =
 66              T.unlines
 67                  [ "Options:"
 68                  , "  -v, --verbose  Be verbose"
 69                  , "  -f, --file=FILE  Input file"
 70                  ]
 71          generated = Clap.generateModule "Test" "test" (Clap.parseHelp testInput)
 72          checks =
 73              [ ("module", "module Aleph.Script.Tools.Test" `T.isInfixOf` generated)
 74              , ("Options", "data Options = Options" `T.isInfixOf` generated)
 75              , ("defaults", "defaults :: Options" `T.isInfixOf` generated)
 76              , ("buildArgs", "buildArgs :: Options -> [Text]" `T.isInfixOf` generated)
 77              ]
 78          failures = [name | (name, ok) <- checks, not ok]
 79      if null failures
 80          then putStrLn "OK"
 81          else do
 82              putStrLn $ "FAILED: missing " ++ show failures
 83              exitFailure
 84  
 85      -- Check 4: No duplicate fields (the bug we fixed)
 86      putStr "Checking no duplicate fields... "
 87      let dupInput =
 88              T.unlines
 89                  [ "Options:"
 90                  , "  -l, --long  First"
 91                  , "  -L, --long  Duplicate" -- Same field name!
 92                  ]
 93          dupGenerated = Clap.generateModule "Test" "test" (Clap.parseHelp dupInput)
 94          fieldCount = length $ filter (== "long ::") $ map T.strip $ T.lines dupGenerated
 95      if fieldCount <= 1
 96          then putStrLn "OK (deduplication works)"
 97          else do
 98              putStrLn $ "FAILED: found " ++ show fieldCount ++ " 'long' fields"
 99              exitFailure
100  
101      putStrLn ""
102      putStrLn "=== All checks passed ==="
103      exitSuccess
104    where
105      isSuffixOf suffix str = drop (length str - length suffix) str == suffix