Flag.hs

-- |
--
-- Module      : Mdoc.Data.Flag
-- Copyright   : (c) 2026 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Mdoc.Data.Flag
  ( Flag (..)
  , Flag1 (..)
  , mapFlag
  , mapFlag1
  , getShort
  , getLong
  ) where

import Mdoc.Prelude

import Data.Text qualified as T
import Mdoc.Pretty

data Flag
  = Flag Char [Flag]
  | GNUFlag String [Flag]
  deriving stock (Eq, Show)

instance Pretty Flag where
  pretty =
    mconcat
      . punctuate " , "
      . mapFlag shortSwitch longSwitch

newtype Flag1 = Flag1
  { unwrap :: Flag
  }

instance Pretty Flag1 where
  pretty = mapFlag1 shortSwitch longSwitch . (.unwrap)

shortSwitch :: Char -> Doc ann
shortSwitch c = "Fl" <+> pretty (esc $ T.singleton c)

longSwitch :: String -> Doc ann
longSwitch s = "Fl Fl" <+> pretty (esc $ pack s)

mapFlag :: (Char -> a) -> (String -> a) -> Flag -> [a]
mapFlag fShort fLong = go
 where
  go = \case
    Flag c as -> fShort c : mconcat (map go as)
    GNUFlag s as -> fLong s : mconcat (map go as)

mapFlag1 :: (Char -> a) -> (String -> a) -> Flag -> a
mapFlag1 fShort fLong = \case
  Flag c _ -> fShort c
  GNUFlag s _ -> fLong s

getShort :: Flag -> Maybe Char
getShort flag = case flag of
  Flag c _ -> Just c
  _ -> Nothing

getLong :: Flag -> Maybe String
getLong flag = case flag of
  Flag {} -> Nothing
  GNUFlag s _ -> Just s