Mdoc.hs

-- |
--
-- Module      : OptEnvConf.Mdoc
-- Copyright   : (c) 2026 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- See "Mdoc.Examples.OptEnvConf".
module OptEnvConf.Mdoc
  ( getPage
  ) where

import Mdoc.Prelude

import Autodocodec.Schema.Mdoc qualified as JSONSchema
import Mdoc.Data.Argument
import Mdoc.Data.Config
import Mdoc.Data.Described
import Mdoc.Data.EnvVar
import Mdoc.Data.Flag
import Mdoc.Data.Option
import Mdoc.Data.Optionality
import Mdoc.Data.Page
import OptEnvConf (ConfDoc (..), EnvDoc (..), OptDoc (..), Parser)
import OptEnvConf.Args (Dashed (..))
import OptEnvConf.Doc
  ( AnyDocs (..)
  , parserConfDocs
  , parserEnvDocs
  , parserOptDocs
  )

getPage :: Parser a -> Page
getPage p =
  flip appEndo mempty
    $ mconcat
      [ foldMap (Endo . either addSwitch addOption . splitEither) $ getParserOpts p
      , foldMap (Endo . addArgument) $ getParserArgs p
      , foldMap (Endo . addEnvVar) $ getParserEnvs p
      , foldMap (Endo . addConfig) $ getParserConfs p
      ]
 where
  splitEither :: Described (Either a b) -> Either (Described a) (Described b)
  splitEither d = case d.item of
    Left a -> Left $ a <$ d
    Right b -> Right $ b <$ d

getParserOpts :: Parser a -> [Described (Either Flag Option)]
getParserOpts = walkNonCommandDocs 0 (maybe [] . optDocToOpt) . parserOptDocs

getParserArgs :: Parser a -> [Described Argument]
getParserArgs = walkNonCommandDocs 0 (maybe [] . optDocToArg) . parserOptDocs

getParserEnvs :: Parser a -> [Described EnvVar]
getParserEnvs = walkNonCommandDocs 0 envDocToEnvVar . parserEnvDocs

-- getParserCmds :: Parser a -> [Command]
-- getParserCmds = walkCommandDocs commandDocToCommand . parserOptDocs

getParserConfs :: Parser a -> [Described Config]
getParserConfs = walkNonCommandDocs 0 confToConfig . parserConfDocs

optDocToOpt :: Int -> OptDoc -> [Described (Either Flag Option)]
optDocToOpt _ doc =
  fromMaybe [] $ do
    flag <- dashedFlags $ optDocDasheds doc

    let item = case optDocMetavar doc of
          Nothing -> Left flag
          Just schema -> Right $ Option {flag, argument = fromString schema}

    pure
      [ Described
          { item
          , optionality = maybe Required Defaulted $ optDocDefault doc
          , multiple = False
          , help = textToMdoc . pack =<< optDocHelp doc
          }
      ]

optDocToArg :: Int -> OptDoc -> [Described Argument]
optDocToArg index doc =
  case (optDocDasheds doc, optDocMetavar doc) of
    ([], Just schema) ->
      [ Described
          { item =
              Argument
                { index
                , schema
                , optionality = Required
                }
          , optionality = maybe Required Defaulted $ optDocDefault doc
          , multiple = False
          , help = textToMdoc . pack =<< optDocHelp doc
          }
      ]
    _ -> []

envDocToEnvVar :: Int -> EnvDoc -> [Described EnvVar]
envDocToEnvVar _ doc =
  [ Described
      { item =
          EnvVar
            { names = envDocVars doc
            , argument = envDocMetavar doc <&> fromString
            }
      , optionality = maybe Required Defaulted $ envDocDefault doc
      , multiple = False
      , help = textToMdoc . pack =<< envDocHelp doc
      }
  ]

-- commandDocToCommand :: CommandDoc (Maybe OptDoc) -> [Command]
-- commandDocToCommand c =
--   [ Command
--       { name = commandDocArgument c
--       , help = Just $ commandDocHelp c
--       , opts = walkNonCommandDocs 0 (maybe [] . optDocToOpt) $ commandDocs c
--       , args = walkNonCommandDocs 0 (maybe [] . optDocToArg) $ commandDocs c
--       , visible = True
--       , required = True
--       , multiple = False
--       , def = Nothing
--       }
--   ]

confToConfig :: Int -> ConfDoc -> [Described Config]
confToConfig _ doc =
  concatMap (\(keys, js) -> addMeta $ JSONSchema.getConfigs (Just keys) js)
    $ toList
    $ confDocKeys doc
 where
  addMeta :: [Described Config] -> [Described Config]
  addMeta = \case
    [] -> []
    (d : ds) ->
      d
        { optionality = maybe Required Defaulted $ confDocDefault doc
        , multiple = False
        , help = textToMdoc . pack =<< confDocHelp doc
        }
        : ds

dashedFlags :: [Dashed] -> Maybe Flag
dashedFlags = fmap go . nonEmpty
 where
  go :: NonEmpty Dashed -> Flag
  go ne =
    let aliases = map (aliasedAs []) $ tail ne
    in  aliasedAs aliases $ head ne

  aliasedAs :: [Flag] -> Dashed -> Flag
  aliasedAs xs = \case
    DashedShort x -> Flag x xs
    DashedLong x -> GNUFlag (toList x) xs

-- walkCommandDocs :: (CommandDoc a -> [b]) -> AnyDocs a -> [b]
-- walkCommandDocs f = \case
--   AnyDocsCommands _mDefault cmds -> concatMap f cmds
--   AnyDocsAnd ds -> concatMap (walkCommandDocs f) ds
--   AnyDocsOr ds -> concatMap (walkCommandDocs f) ds
--   AnyDocsSingle {} -> []

walkNonCommandDocs
  :: Int -> (Int -> a -> [Described b]) -> AnyDocs a -> [Described b]
walkNonCommandDocs index f = \case
  AnyDocsCommands {} -> []
  AnyDocsAnd ds -> concatMap (walkNonCommandDocs (index + 1) f) ds
  AnyDocsOr ds -> concatMap (map mkMultiple . walkNonCommandDocs (index + 1) f) ds
  AnyDocsSingle d -> f index d
 where
  -- This is suspect, but it seems we can't distinguish if the Or is being used
  -- to indicate some/many or optionality. We'll just treat it as both since it
  -- passes our current tests.
  mkMultiple d = d {optionality = Optional, multiple = True}