content: {-# 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 " -"
  