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

optDocPart :: OptDoc -> Part
optDocPart :: OptDoc -> Part
optDocPart OptDoc
doc = Part -> Part
bracketize Part
go
 where
  go :: Part
go
    | [Dashed] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (OptDoc -> [Dashed]
optDocDasheds OptDoc
doc)
    , Just Metavar
mv <- OptDoc -> Maybe Metavar
optDocMetavar OptDoc
doc =
        case OptDoc -> Maybe Metavar
optDocDefault OptDoc
doc of
          Maybe Metavar
Nothing -> Part -> Part
Variable (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Metavar -> Part
forall a. IsString a => Metavar -> a
fromString Metavar
mv
          Just {} -> Part -> Part
Brackets (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Metavar -> Part
forall a. IsString a => Metavar -> a
fromString Metavar
mv
    | Bool
otherwise =
        [Part] -> Part
Concat ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$
          Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
intersperse Part
"\\|" ([Part] -> [Part]) -> [Part] -> [Part]
forall a b. (a -> b) -> a -> b
$
            OptDoc -> [Part]
optDashedParts OptDoc
doc

  bracketize :: Part -> Part
bracketize = case OptDoc -> Maybe Metavar
optDocDefault OptDoc
doc of
    Maybe Metavar
Nothing -> Part -> Part
forall a. a -> a
id
    Just {} -> Part -> Part
Brackets

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

optDocDefinition :: OptDoc -> Definition
optDocDefinition :: OptDoc -> Definition
optDocDefinition OptDoc
doc =
  Definition
    { Part
name :: Part
$sel:name:Definition :: Part
name
    , $sel:description:Definition :: Line
description =
        [Part] -> Line
Line ([Part] -> Line) -> [Part] -> Line
forall a b. (a -> b) -> a -> b
$
          [[Part]] -> [Part]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Part] -> (Metavar -> [Part]) -> Maybe Metavar -> [Part]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Part -> [Part]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Part -> [Part]) -> (Metavar -> Part) -> Metavar -> [Part]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metavar -> Part
forall a. IsString a => Metavar -> a
fromString) (Maybe Metavar -> [Part]) -> Maybe Metavar -> [Part]
forall a b. (a -> b) -> a -> b
$ OptDoc -> Maybe Metavar
optDocHelp OptDoc
doc
            , [Part] -> (Metavar -> [Part]) -> Maybe Metavar -> [Part]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Metavar
d -> Part -> [Part]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Part -> [Part]) -> Part -> [Part]
forall a b. (a -> b) -> a -> b
$ Part -> Part
Parens (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part
"default " Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> Metavar -> Part
forall a. IsString a => Metavar -> a
fromString Metavar
d) (Maybe Metavar -> [Part]) -> Maybe Metavar -> [Part]
forall a b. (a -> b) -> a -> b
$ OptDoc -> Maybe Metavar
optDocDefault OptDoc
doc
            ]
    , $sel:content:Definition :: Maybe [Content]
content = Maybe [Content]
forall a. Maybe a
Nothing
    }
 where
  name :: Part
name
    | [Dashed] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (OptDoc -> [Dashed]
optDocDasheds OptDoc
doc)
    , Just Metavar
mv <- OptDoc -> Maybe Metavar
optDocMetavar OptDoc
doc =
        Part -> Part
Code (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Metavar -> Part
forall a. IsString a => Metavar -> a
fromString Metavar
mv
    | Bool
otherwise = [Part] -> Part
Concat ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
intersperse Part
", " ([Part] -> [Part]) -> [Part] -> [Part]
forall a b. (a -> b) -> a -> b
$ OptDoc -> [Part]
optDashedParts OptDoc
doc

optDashedParts :: OptDoc -> [Part]
optDashedParts :: OptDoc -> [Part]
optDashedParts OptDoc
doc =
  (Char -> Part) -> Metavar -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> [Part] -> Part
Concat [Part -> Part
Code (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part
"-" Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> Text -> Part
Raw (Char -> Text
T.singleton Char
c)]) Metavar
shorts
    [Part] -> [Part] -> [Part]
forall a. Semigroup a => a -> a -> a
<> (Metavar -> Part) -> [Metavar] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map
      (\Metavar
n -> [Part] -> Part
Concat ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ Maybe Metavar -> [Part] -> [Part]
addArgument (OptDoc -> Maybe Metavar
optDocMetavar OptDoc
doc) [Part -> Part
Code (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part
"--" Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> Text -> Part
Raw (Metavar -> Text
pack Metavar
n)])
      [Metavar]
longs
 where
  (Metavar
shorts, [Metavar]
longs) = [Dashed] -> (Metavar, [Metavar])
partitionDasheds ([Dashed] -> (Metavar, [Metavar]))
-> [Dashed] -> (Metavar, [Metavar])
forall a b. (a -> b) -> a -> b
$ OptDoc -> [Dashed]
optDocDasheds OptDoc
doc

addArgument :: Maybe String -> [Part] -> [Part]
addArgument :: Maybe Metavar -> [Part] -> [Part]
addArgument = \case
  Maybe Metavar
Nothing -> [Part] -> [Part]
forall a. a -> a
id
  Just Metavar
arg -> ([Part] -> [Part] -> [Part]
forall a. Semigroup a => a -> a -> a
<> [Part
"=", Part -> Part
Variable (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Metavar -> Part
forall a. IsString a => Metavar -> a
fromString Metavar
arg])

partitionDasheds :: [Dashed] -> ([Char], [String])
partitionDasheds :: [Dashed] -> (Metavar, [Metavar])
partitionDasheds = (Metavar, [Metavar]) -> [Dashed] -> (Metavar, [Metavar])
go ([], [])
 where
  go :: (Metavar, [Metavar]) -> [Dashed] -> (Metavar, [Metavar])
go acc :: (Metavar, [Metavar])
acc@(Metavar
shorts, [Metavar]
longs) = \case
    [] -> (Metavar, [Metavar])
acc
    (DashedShort Char
c : [Dashed]
ds) -> (Metavar, [Metavar]) -> [Dashed] -> (Metavar, [Metavar])
go (Metavar
shorts Metavar -> Metavar -> Metavar
forall a. Semigroup a => a -> a -> a
<> [Char
c], [Metavar]
longs) [Dashed]
ds
    (DashedLong NonEmpty Char
cs : [Dashed]
ds) -> (Metavar, [Metavar]) -> [Dashed] -> (Metavar, [Metavar])
go (Metavar
shorts, [Metavar]
longs [Metavar] -> [Metavar] -> [Metavar]
forall a. Semigroup a => a -> a -> a
<> [NonEmpty Char -> Metavar
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Char
cs]) [Dashed]
ds