module Cardano.CLI.Render
  ( customRenderHelp
  ) where

import           Cardano.Prelude
import           Data.Function (id)
import           Options.Applicative
import           Options.Applicative.Help.Ann
import           Options.Applicative.Help.Types (helpText, renderHelp)
import           Prelude (String)
import           Prettyprinter
import           Prettyprinter.Render.Util.SimpleDocTree

import qualified Data.Text as T
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 (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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
wrapper
  (Text -> Text) -> (ParserHelp -> Text) -> ParserHelp -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SimpleDocStream Ann -> SimpleDocTree Ann
forall ann. SimpleDocStream ann -> SimpleDocTree ann
treeForm
  (SimpleDocStream Ann -> SimpleDocTree Ann)
-> (ParserHelp -> SimpleDocStream Ann)
-> ParserHelp
-> SimpleDocTree Ann
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 b. (Show a, ConvertText String b) => a -> b
show 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text
"<html>\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
        (Text -> Text) -> (Text -> Text) -> Text -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text
"<body>\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
        (Text -> Text) -> (Text -> Text) -> Text -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text
"<pre>\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
        (Text -> Text) -> (Text -> Text) -> Text -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n</html>")
        (Text -> Text) -> (Text -> Text) -> Text -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n</body>")
        (Text -> Text) -> (Text -> Text) -> Text -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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