1  {-# LANGUAGE OverloadedStrings #-}
  2  {-# LANGUAGE RecordWildCards #-}
  3  
  4  {- | Test parser against real tool help outputs
  5  
  6  Run: runghc -i. corpus-test.hs
  7  -}
  8  module Main where
  9  
 10  import Aleph.Script.Clap
 11  import Control.Monad (forM, forM_)
 12  import Data.List (sortOn)
 13  import Data.Maybe (isJust)
 14  import Data.Text (Text)
 15  import qualified Data.Text as T
 16  import qualified Data.Text.IO as TIO
 17  import System.Directory (listDirectory)
 18  import System.FilePath (takeBaseName, (</>))
 19  
 20  -- ============================================================================
 21  -- Statistics
 22  -- ============================================================================
 23  
 24  data ParseStats = ParseStats
 25      { statsTool :: String
 26      , statsVariant :: String
 27      , statsNumSections :: Int
 28      , statsNumOptions :: Int
 29      , statsNumPositionals :: Int
 30      , statsOptionsWithShort :: Int
 31      , statsOptionsWithLong :: Int
 32      , statsOptionsWithArg :: Int
 33      }
 34      deriving (Show)
 35  
 36  computeStats :: String -> String -> ClapHelp -> ParseStats
 37  computeStats tool variant ClapHelp{..} =
 38      let allOpts = concatMap secOptions helpSections
 39       in ParseStats
 40              { statsTool = tool
 41              , statsVariant = variant
 42              , statsNumSections = length helpSections
 43              , statsNumOptions = length allOpts
 44              , statsNumPositionals = length helpPositionals
 45              , statsOptionsWithShort = length $ filter (isJust . optShort) allOpts
 46              , statsOptionsWithLong = length $ filter (isJust . optLong) allOpts
 47              , statsOptionsWithArg = length $ filter (isJust . optArg) allOpts
 48              }
 49  
 50  -- ============================================================================
 51  -- Main
 52  -- ============================================================================
 53  
 54  main :: IO ()
 55  main = do
 56      putStrLn "=== Corpus Test: Real Tool Help Parsing ==="
 57      putStrLn ""
 58  
 59      let corpusDir = "corpus"
 60      files <- listDirectory corpusDir
 61      let txtFiles = sortOn id $ filter (\f -> ".txt" `isSuffixOf` f && not (null f)) files
 62  
 63      results <- forM txtFiles $ \file -> do
 64          let path = corpusDir </> file
 65              base = takeBaseName file
 66              (tool, variant) = case break (== '-') base of
 67                  (t, '-' : v) -> (t, v)
 68                  (t, _) -> (t, "unknown")
 69  
 70          content <- TIO.readFile path
 71          let help = parseHelp content
 72              stats = computeStats tool variant help
 73          return stats
 74  
 75      -- Print table header
 76      putStrLn $
 77          padRight 15 "Tool"
 78              ++ padRight 8 "Variant"
 79              ++ padRight 6 "Secs"
 80              ++ padRight 6 "Opts"
 81              ++ padRight 6 "Pos"
 82              ++ padRight 8 "Short"
 83              ++ padRight 8 "Long"
 84              ++ padRight 8 "Args"
 85      putStrLn $ replicate 70 '-'
 86  
 87      -- Print each result
 88      forM_ results $ \ParseStats{..} -> do
 89          putStrLn $
 90              padRight 15 statsTool
 91                  ++ padRight 8 statsVariant
 92                  ++ padRight 6 (show statsNumSections)
 93                  ++ padRight 6 (show statsNumOptions)
 94                  ++ padRight 6 (show statsNumPositionals)
 95                  ++ padRight 8 (show statsOptionsWithShort)
 96                  ++ padRight 8 (show statsOptionsWithLong)
 97                  ++ padRight 8 (show statsOptionsWithArg)
 98  
 99      -- Summary
100      let totalOpts = sum $ map statsNumOptions results
101          totalPos = sum $ map statsNumPositionals results
102      putStrLn $ replicate 70 '-'
103      putStrLn $
104          "Total: "
105              ++ show (length results)
106              ++ " files, "
107              ++ show totalOpts
108              ++ " options, "
109              ++ show totalPos
110              ++ " positionals parsed"
111    where
112      padRight n s = take n (s ++ repeat ' ')
113      isSuffixOf suffix str = drop (length str - length suffix) str == suffix