Opt.hs

-- |
--
-- Module      : Ronn.OptEnvConf.Opt
-- Copyright   : (c) 2024 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Ronn.OptEnvConf.Opt
  ( optSynopsis
  , optDefinitions
  ) where

import Prelude

import Data.Foldable (toList)
import Data.List (intersperse)
import Data.String (IsString (..))
import Data.Text (pack)
import Data.Text qualified as T
import OptEnvConf (Parser)
import OptEnvConf.Args (Dashed (..))
import OptEnvConf.Doc (AnyDocs (..), OptDoc (..), parserOptDocs)
import Ronn.AST

optSynopsis :: Parser a -> [Part]
optSynopsis = go False . parserOptDocs
 where
  go :: Bool -> AnyDocs (Maybe OptDoc) -> [Part]
  go nested = \case
    AnyDocsCommands {} -> [] -- TODO
    AnyDocsAnd ds -> concatMap (go True) ds
    AnyDocsOr [AnyDocsSingle (Just d)] -> [Brackets $ optDocPart d] -- optional d
    AnyDocsOr ds ->
      [ (if nested then Parens else id)
          $ Concat
          $ intersperse " \\| "
          $ concatMap (go True) ds
      ]
    AnyDocsSingle Nothing -> []
    AnyDocsSingle (Just d) -> [optDocPart d]

optDocPart :: OptDoc -> Part
optDocPart doc = bracketize go
 where
  go
    | null (optDocDasheds doc)
    , Just mv <- optDocMetavar doc =
        case optDocDefault doc of
          Nothing -> Variable $ fromString mv
          Just {} -> Brackets $ fromString mv
    | otherwise =
        Concat
          $ intersperse "\\|"
          $ optDashedParts doc

  bracketize = case optDocDefault doc of
    Nothing -> id
    Just {} -> Brackets

optDefinitions :: Parser a -> [Definition]
optDefinitions = go . parserOptDocs
 where
  go :: AnyDocs (Maybe OptDoc) -> [Definition]
  go = \case
    AnyDocsCommands {} -> [] -- TODO
    AnyDocsAnd ds -> concatMap go ds
    AnyDocsOr ds -> concatMap go ds
    AnyDocsSingle Nothing -> []
    AnyDocsSingle (Just d) -> [optDocDefinition d]

optDocDefinition :: OptDoc -> Definition
optDocDefinition doc =
  Definition
    { name
    , description =
        concat
          [ maybe [] (pure . fromString) $ optDocHelp doc
          , maybe [] (\d -> pure $ Parens $ "default " <> fromString d) $ optDocDefault doc
          ]
    , content = Nothing
    }
 where
  name
    | null (optDocDasheds doc)
    , Just mv <- optDocMetavar doc =
        Code $ fromString mv
    | otherwise = Concat $ intersperse ", " $ optDashedParts doc

optDashedParts :: OptDoc -> [Part]
optDashedParts doc =
  map (\c -> Concat [Code $ "-" <> Raw (T.singleton c)]) shorts
    <> map
      (\n -> Concat $ addArgument (optDocMetavar doc) [Code $ "--" <> Raw (pack n)])
      longs
 where
  (shorts, longs) = partitionDasheds $ optDocDasheds doc

addArgument :: Maybe String -> [Part] -> [Part]
addArgument = \case
  Nothing -> id
  Just arg -> (<> ["=", Variable $ fromString arg])

partitionDasheds :: [Dashed] -> ([Char], [String])
partitionDasheds = go ([], [])
 where
  go acc@(shorts, longs) = \case
    [] -> acc
    (DashedShort c : ds) -> go (shorts <> [c], longs) ds
    (DashedLong cs : ds) -> go (shorts, longs <> [toList cs]) ds