-- |
--
-- Module      : Ronn.Opt
-- Copyright   : (c) 2024 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Ronn.Opt
  ( Opts (..)
  , optsToDefinitions
  , Opt (..)
  , optToDefinition
  , optionsSection
  , synopsisSection
  , synopsisLine
  ) where

import Prelude

import Data.List (intersperse)
import Data.Maybe (fromMaybe, isJust)
import Data.String (IsString (..))
import Ronn.AST
import Ronn.Argument

data Opts
  = OptsOr Opts
  | OptsAnd Opts
  | OptsMany [Opts]
  | OptsOne Opt

optsToDefinitions :: Opts -> [RonnDefinition]
optsToDefinitions :: Opts -> [RonnDefinition]
optsToDefinitions = \case
  OptsOr Opts
opts -> Opts -> [RonnDefinition]
optsToDefinitions Opts
opts
  OptsAnd Opts
opts -> Opts -> [RonnDefinition]
optsToDefinitions Opts
opts
  OptsMany [Opts]
opts -> (Opts -> [RonnDefinition]) -> [Opts] -> [RonnDefinition]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Opts -> [RonnDefinition]
optsToDefinitions [Opts]
opts
  OptsOne Opt
opts -> [Opt -> RonnDefinition
optToDefinition Opt
opts]

data Opt = Opt
  { Opt -> String
shorts :: [Char]
  , Opt -> [String]
longs :: [String]
  , Opt -> Maybe String
argument :: Maybe String
  , Opt -> Maybe String
default_ :: Maybe String
  , Opt -> Maybe RonnLine
help :: Maybe RonnLine
  }

instance HasArgument Opt where
  getArgument :: Opt -> Maybe String
getArgument = (.argument)

optToDefinition :: Opt -> RonnDefinition
optToDefinition :: Opt -> RonnDefinition
optToDefinition Opt
opt =
  RonnDefinition
    { $sel:name:RonnDefinition :: RonnPart
name = [RonnPart] -> RonnPart
forall a. Monoid a => [a] -> a
mconcat ([RonnPart] -> RonnPart) -> [RonnPart] -> RonnPart
forall a b. (a -> b) -> a -> b
$ RonnPart -> [RonnPart] -> [RonnPart]
forall a. a -> [a] -> [a]
intersperse RonnPart
", " ([RonnPart] -> [RonnPart]) -> [RonnPart] -> [RonnPart]
forall a b. (a -> b) -> a -> b
$ Opt -> [RonnPart]
optParts Opt
opt
    , $sel:description:RonnDefinition :: RonnLine
description = RonnLine -> Maybe RonnLine -> RonnLine
forall a. a -> Maybe a -> a
fromMaybe ([RonnPart] -> RonnLine
RonnLine []) Opt
opt.help
    , $sel:content:RonnDefinition :: Maybe [RonnContent]
content = Maybe [RonnContent]
forall a. Maybe a
Nothing
    }

optionsSection :: Opts -> RonnSection
optionsSection :: Opts -> RonnSection
optionsSection Opts
opts =
  RonnSection
    { $sel:name:RonnSection :: Text
name = Text
"OPTIONS"
    , $sel:content:RonnSection :: [RonnContent]
content = [[RonnDefinition] -> RonnContent
RonnDefinitions ([RonnDefinition] -> RonnContent)
-> [RonnDefinition] -> RonnContent
forall a b. (a -> b) -> a -> b
$ Opts -> [RonnDefinition]
optsToDefinitions Opts
opts]
    }

synopsisSection
  :: String
  -- ^ Program name
  -> Opts
  -> RonnSection
synopsisSection :: String -> Opts -> RonnSection
synopsisSection String
name Opts
opts =
  RonnSection
    { $sel:name:RonnSection :: Text
name = Text
"SYNOPSIS"
    , $sel:content:RonnSection :: [RonnContent]
content = [[RonnGroup] -> RonnContent
RonnGroups [[RonnLine] -> RonnGroup
RonnLines [String -> Opts -> RonnLine
synopsisLine String
name Opts
opts]]]
    }

synopsisLine :: String -> Opts -> RonnLine
synopsisLine :: String -> Opts -> RonnLine
synopsisLine String
name = [RonnPart] -> RonnLine
RonnLine ([RonnPart] -> RonnLine)
-> (Opts -> [RonnPart]) -> Opts -> RonnLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RonnPart -> RonnPart
RonnCode (String -> RonnPart
forall a. IsString a => String -> a
fromString String
name) :) ([RonnPart] -> [RonnPart])
-> (Opts -> [RonnPart]) -> Opts -> [RonnPart]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opts -> [RonnPart]
go
 where
  go :: Opts -> [RonnPart]
  go :: Opts -> [RonnPart]
go = \case
    OptsOr Opts
os -> [RonnPart -> RonnPart
RonnBrackets (RonnPart -> RonnPart) -> RonnPart -> RonnPart
forall a b. (a -> b) -> a -> b
$ [RonnPart] -> RonnPart
forall a. Monoid a => [a] -> a
mconcat ([RonnPart] -> RonnPart) -> [RonnPart] -> RonnPart
forall a b. (a -> b) -> a -> b
$ RonnPart -> [RonnPart] -> [RonnPart]
forall a. a -> [a] -> [a]
intersperse RonnPart
" \\| " ([RonnPart] -> [RonnPart]) -> [RonnPart] -> [RonnPart]
forall a b. (a -> b) -> a -> b
$ Opts -> [RonnPart]
go Opts
os]
    OptsAnd Opts
os -> [RonnPart -> RonnPart
RonnParens (RonnPart -> RonnPart) -> RonnPart -> RonnPart
forall a b. (a -> b) -> a -> b
$ [RonnPart] -> RonnPart
forall a. Monoid a => [a] -> a
mconcat ([RonnPart] -> RonnPart) -> [RonnPart] -> RonnPart
forall a b. (a -> b) -> a -> b
$ RonnPart -> [RonnPart] -> [RonnPart]
forall a. a -> [a] -> [a]
intersperse RonnPart
" " ([RonnPart] -> [RonnPart]) -> [RonnPart] -> [RonnPart]
forall a b. (a -> b) -> a -> b
$ Opts -> [RonnPart]
go Opts
os]
    OptsMany [Opts]
os -> (Opts -> [RonnPart]) -> [Opts] -> [RonnPart]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Opts -> [RonnPart]
go [Opts]
os
    OptsOne Opt
opt -> (RonnPart -> RonnPart) -> [RonnPart] -> [RonnPart]
forall a b. (a -> b) -> [a] -> [b]
map (Opt -> RonnPart -> RonnPart
bracketize Opt
opt) ([RonnPart] -> [RonnPart]) -> [RonnPart] -> [RonnPart]
forall a b. (a -> b) -> a -> b
$ Opt -> [RonnPart]
optParts Opt
opt

  bracketize :: Opt -> RonnPart -> RonnPart
  bracketize :: Opt -> RonnPart -> RonnPart
bracketize Opt
opt
    | Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Opt
opt.default_ = RonnPart -> RonnPart
RonnBrackets
    | Bool
otherwise = RonnPart -> RonnPart
forall a. a -> a
id

optParts :: Opt -> [RonnPart]
optParts :: Opt -> [RonnPart]
optParts Opt
opt
  | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Opt
opt.shorts Bool -> Bool -> Bool
&& [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Opt
opt.longs
  , Just String
arg <- Opt
opt.argument =
      [RonnPart -> RonnPart
RonnVariable (RonnPart -> RonnPart) -> RonnPart -> RonnPart
forall a b. (a -> b) -> a -> b
$ String -> RonnPart
forall a. IsString a => String -> a
fromString String
arg]
  | Bool
otherwise =
      (Char -> RonnPart) -> String -> [RonnPart]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Opt -> RonnPart -> RonnPart
forall a. HasArgument a => Text -> a -> RonnPart -> RonnPart
addArgument Text
" " Opt
opt (RonnPart -> RonnPart) -> (Char -> RonnPart) -> Char -> RonnPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> RonnPart
short) Opt
opt.shorts
        [RonnPart] -> [RonnPart] -> [RonnPart]
forall a. Semigroup a => a -> a -> a
<> (String -> RonnPart) -> [String] -> [RonnPart]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Opt -> RonnPart -> RonnPart
forall a. HasArgument a => Text -> a -> RonnPart -> RonnPart
addArgument Text
"=" Opt
opt (RonnPart -> RonnPart)
-> (String -> RonnPart) -> String -> RonnPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RonnPart
long) Opt
opt.longs
 where
  short :: Char -> RonnPart
  short :: Char -> RonnPart
short = RonnPart -> RonnPart
RonnCode (RonnPart -> RonnPart) -> (Char -> RonnPart) -> Char -> RonnPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RonnPart
forall a. IsString a => String -> a
fromString (String -> RonnPart) -> (Char -> String) -> Char -> RonnPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'-' :) (String -> String) -> (Char -> String) -> Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  long :: String -> RonnPart
  long :: String -> RonnPart
long = RonnPart -> RonnPart
RonnCode (RonnPart -> RonnPart)
-> (String -> RonnPart) -> String -> RonnPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RonnPart
forall a. IsString a => String -> a
fromString (String -> RonnPart) -> (String -> String) -> String -> RonnPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"--" <>)