{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module YamlParse.Applicative.OptParse where

import qualified Data.Text as T
import qualified Options.Applicative as OptParse
import qualified Options.Applicative.Help as OptParse
import YamlParse.Applicative.Class
import YamlParse.Applicative.Explain
import YamlParse.Applicative.Parser
import YamlParse.Applicative.Pretty

-- | Helper function to add the schema documentation for a 'YamlSchema' parser to the optparse applicative help output
confDesc :: forall o a. YamlSchema o => OptParse.InfoMod a
confDesc :: InfoMod a
confDesc = Parser Value o -> InfoMod a
forall i o a. Parser i o -> InfoMod a
confDescWith (Parser Value o
forall a. YamlSchema a => YamlParser a
yamlSchema :: YamlParser o)

-- | Helper function to add the schema documentation for a given parser to the optparse applicative help output
confDescWith :: Parser i o -> OptParse.InfoMod a
confDescWith :: Parser i o -> InfoMod a
confDescWith Parser i o
p = Maybe Doc -> InfoMod a
forall a. Maybe Doc -> InfoMod a
OptParse.footerDoc (Maybe Doc -> InfoMod a) -> Maybe Doc -> InfoMod a
forall a b. (a -> b) -> a -> b
$ Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
OptParse.string (String -> Doc) -> (Schema -> String) -> Schema -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Schema -> Text) -> Schema -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Text
prettyColourisedSchema (Schema -> Doc) -> Schema -> Doc
forall a b. (a -> b) -> a -> b
$ Parser i o -> Schema
forall i o. Parser i o -> Schema
explainParser Parser i o
p