{- HLINT ignore "Redundant id" -}

module Cardano.CLI.Render
  ( customRenderHelp
  , renderAnyCmdError
  )
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 #-}

-- | Convert a help text to 'String'.  When the CLI_HELP_TRACE environment variable is set
-- to '1', the output will be in HTML so that it can be viewed in a browser where developer
-- tools can be used to inspect tracing that aids in describing the structure of the output
-- document.
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

renderAnyCmdError :: Text -> (a -> Doc ann) -> a -> Doc ann
renderAnyCmdError :: forall a ann. Text -> (a -> Doc ann) -> a -> Doc ann
renderAnyCmdError Text
cmdText a -> Doc ann
renderer a
shelCliCmdErr =
  [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
    [ Doc ann
"Command failed: "
    , Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
cmdText
    , Doc ann
"  Error: "
    , a -> Doc ann
renderer a
shelCliCmdErr
    ]