1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
module Cabal.ReplOptionsSpec (spec, unsupported) where
import Imports
import Test.Hspec
import Data.List
import System.Process
import Data.Set (Set)
import qualified Data.Set as Set
import Cabal.ReplOptions
phony :: [String]
phony = [
"with-PROG"
, "PROG-option"
, "PROG-options"
]
undocumented :: Set String
undocumented = Set.fromList [
"--enable-optimisation"
, "--disable-optimisation"
, "--haddock-hyperlink-sources"
, "--haddock-hyperlinked-source"
]
unsupported :: Set String
unsupported = undocumented <> Set.fromList (map ("--" <>) phony)
spec :: Spec
spec = do
describe "options" $ do
it "is the list of documented 'repl' options" $ do
documentedOptions <- parseOptions <$> readProcess "cabal" ["help", "repl"] ""
options `shouldBe` filter (optionName >>> (`notElem` phony)) documentedOptions
it "is consistent with 'cabal repl --list-options'" $ do
let
optionNames :: Option -> [String]
optionNames option = reverse $ "--" <> optionName option : case optionShortName option of
Nothing -> []
Just c -> [['-', c]]
repl <- filter (`Set.notMember` unsupported) . lines <$> readProcess "cabal" ["repl", "--list-options"] ""
concatMap optionNames options `shouldBe` repl
parseOptions :: String -> [Option]
parseOptions = map parseOption . takeOptions
where
parseOption :: String -> Option
parseOption input = case input of
longAndHelp@('-':'-':_) -> parseLongOption Nothing longAndHelp
'-':short:',':' ':longAndHelp -> parseLongOption (Just short) longAndHelp
'-':short:'[':(breakOn ']' ->
(_arg, ']':',':' ':longAndHelp)) -> parseLongOption (Just short) longAndHelp
'-':short:' ':(breakOn ' ' ->
(arg, ' ':'o':'r':' ':(stripPrefix ('-':short:arg) ->
Just (',':' ':longAndHelp)))) -> parseLongOption (Just short) longAndHelp
_ -> err
where
parseLongOption :: Maybe Char -> String -> Option
parseLongOption short longAndHelp = case breakOnAny " [=" longAndHelp of
('-':'-':long, ' ':help) -> accept long NoArgument help
('-':'-':long, '[':'=': (breakOn ']' ->
(arg, ']':help))) -> accept long (OptionalArgument arg) help
('-':'-':long, '=':(breakOn ' ' ->
(arg, ' ':help))) -> accept long (Argument arg) help
_ -> err
where
accept :: String -> Argument -> String -> Option
accept long arg help = Option long short arg (strip help)
err :: HasCallStack => Option
err = error input
breakOn c = break (== c)
breakOnAny xs = break (`elem` xs)
takeOptions :: String -> [String]
takeOptions input = map strip . joinLines $ case break (== "Flags for repl:") (lines input) of
(_, "Flags for repl:" : xs) -> case break (== "") xs of
(ys, "" : _) -> ys
_ -> undefined
_ -> undefined
joinLines :: [String] -> [String]
joinLines = go
where
go = \ case
x : y : ys | isOption y -> x : go (y : ys)
x : y : ys -> go $ (x ++ ' ' : strip y) : ys
x : xs -> x : xs
[] -> []
isOption = isPrefixOf " -"
|
