module Cardano.CLI.Render
( customRenderHelp
)
where
import Cardano.Api (textShow)
import Data.Text (Text)
import qualified Data.Text as T
import Options.Applicative
import Options.Applicative.Help.Ann
import Options.Applicative.Help.Types (helpText, renderHelp)
import Prettyprinter
import Prettyprinter.Render.Util.SimpleDocTree
import qualified System.Environment as IO
import qualified System.IO.Unsafe as IO
cliHelpTraceEnabled :: Bool
cliHelpTraceEnabled :: Bool
cliHelpTraceEnabled = IO Bool -> Bool
forall a. IO a -> a
IO.unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
Maybe String
mValue <- String -> IO (Maybe String)
IO.lookupEnv String
"CLI_HELP_TRACE"
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Maybe String
mValue Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"1"
{-# NOINLINE cliHelpTraceEnabled #-}
customRenderHelp :: Int -> ParserHelp -> String
customRenderHelp :: Int -> ParserHelp -> String
customRenderHelp =
if Bool
cliHelpTraceEnabled
then Int -> ParserHelp -> String
customRenderHelpAsHtml
else Int -> ParserHelp -> String
customRenderHelpAsAnsi
customRenderHelpAsHtml :: Int -> ParserHelp -> String
customRenderHelpAsHtml :: Int -> ParserHelp -> String
customRenderHelpAsHtml Int
cols =
Text -> String
T.unpack
(Text -> String) -> (ParserHelp -> Text) -> ParserHelp -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
wrapper
(Text -> Text) -> (ParserHelp -> Text) -> ParserHelp -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text)
-> (Ann -> Text -> Text) -> SimpleDocTree Ann -> Text
forall out ann.
Monoid out =>
(Text -> out) -> (ann -> out -> out) -> SimpleDocTree ann -> out
renderSimplyDecorated Text -> Text
forall a. a -> a
id Ann -> Text -> Text
renderElement
(SimpleDocTree Ann -> Text)
-> (ParserHelp -> SimpleDocTree Ann) -> ParserHelp -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream Ann -> SimpleDocTree Ann
forall ann. SimpleDocStream ann -> SimpleDocTree ann
treeForm
(SimpleDocStream Ann -> SimpleDocTree Ann)
-> (ParserHelp -> SimpleDocStream Ann)
-> ParserHelp
-> SimpleDocTree Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Ann -> SimpleDocStream Ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart (PageWidth -> LayoutOptions
LayoutOptions (Int -> Double -> PageWidth
AvailablePerLine Int
cols Double
1.0))
(Doc Ann -> SimpleDocStream Ann)
-> (ParserHelp -> Doc Ann) -> ParserHelp -> SimpleDocStream Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserHelp -> Doc Ann
helpText
where
renderElement :: Ann -> Text -> Text
renderElement :: Ann -> Text -> Text
renderElement Ann
ann Text
x =
if Bool
cliHelpTraceEnabled
then case Ann
ann of
AnnTrace Int
_ String
name -> Text
"<span name=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
textShow String
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</span>"
AnnStyle SetStyle
_ -> Text
x
else Text
x
wrapper :: Text -> Text
wrapper =
if Bool
cliHelpTraceEnabled
then
Text -> Text
forall a. a -> a
id
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"<html>\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"<body>\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"<pre>\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n</html>")
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n</body>")
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n</pre>")
else Text -> Text
forall a. a -> a
id
customRenderHelpAsAnsi :: Int -> ParserHelp -> String
customRenderHelpAsAnsi :: Int -> ParserHelp -> String
customRenderHelpAsAnsi = Int -> ParserHelp -> String
renderHelp