{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PartialTypeSignatures #-} module Test.Data.Registry.Options.DisplayHelpBoxSpec where import Data.Registry import Data.Registry.Options import Data.Text qualified as T import Protolude import Test.Tasty.Hedgehogx hiding (OptionDescription, display) import Text.PrettyPrint.Boxes hiding ((<>)) test_display_metavar_box = test "displayMetavarBox" $ do showB @"metavar" (metavar "FILE" mempty) === "FILE" showB @"metavar" (metavar "[CHAR]" mempty) === "STRING" test_display_metavar_usage_box = test "displayMetavarUsageBox" $ do showB @"metavar-usage" (metavar "FILE" mempty) === "FILE" showB @"metavar-usage" (metavar "[CHAR]" mempty) === "" showB @"metavar-usage" (metavar "" mempty) === "" test_display_option_help_box = test "displayOptionHelpBox" $ do showB @"option-help" noOption === "" showB @"option-help" (help "some help" mempty) === "some help" test_display_option_flag_box = test "displayOptionFlagBox" $ do showB @"option-flag" noOption === "" showB @"option-flag" (name "name" <> short 'n' $ noOption) === "-n,--name" showB @"option-flag" (metavar "FILE" <> name "name" <> short 'n' $ noOption) === "-n,--name FILE" test_display_option_usage_box = test "displayOptionUsageBox" $ do showB @"option-usage" noOption === "" showB @"option-usage" (name "name" <> short 'n' $ noOption) === "[-n|--name]" showB @"option-usage" (metavar "FILE" <> name "name" $ noOption) === "[--name FILE]" showB @"option-usage" (metavar "FILE" <> name "name" <> short 'n' $ noOption) === "[-n|--name FILE]" test_display_option_box = test "displayOptionBox" $ do showB @"option" noOption === "" showB @"option" (name "name" <> short 'n' $ noOption) === "-n,--name" showB @"option" (name "name" <> short 'n' <> help "some help" $ noOption) === "-n,--name some help" showB @"option" (metavar "FILE" <> name "name" <> short 'n' <> help "some help" $ noOption) === "-n,--name FILE some help" test_table = test "table" $ do let tps = TableParameters left top 10 let width = 10 -- when the help text fits on a single line renderBox ( table tps [ [paragraph width "o|option", paragraph 10 "long help"], [paragraph width "FILE", paragraph width "help"] ] ) === T.intercalate "\n" [ "o|option long help", "FILE help " ] -- when the help text fits on a single line needs to wrap renderBox ( table tps [ [paragraph width "o|option", paragraph width "long help very long help which doesn't fit a column"], [paragraph width "FILE", paragraph width "help"] ] ) === T.intercalate "\n" [ "o|option long help ", " very long ", " help which", " doesn't ", " fit a ", " column ", "FILE help " ] test_display_command_options_box = test "displayCommandOptionsBox" $ do showB @"command-options" [noOption] === "" showB @"command-options" [name "name" <> short 'n' $ noOption] === "-n,--name " showB @"command-options" [name "name" <> short 'n' <> help "name help" $ noOption] === "-n,--name name help" showB @"command-options" [metavar "FILE" <> name "name" <> short 'n' <> help "name help" $ noOption] === "-n,--name FILE name help" showB @"command-options" [ name "name" <> short 'n' <> help "name help" $ noOption, name "force" <> short 'f' <> help "force help" $ noOption ] === T.intercalate "\n" [ "-n,--name name help ", "-f,--force force help" ] -- * Helpers showB :: forall (t :: Symbol) a. (KnownSymbol t, Typeable a) => a -> Text showB = renderBox . display (make @(Display t a Box) displayBoxRegistry) noOption = mempty :: OptionDescription