packages feed

mdoc-0.2.0.0: src/Mdoc/Data/Positional.hs

-- |
--
-- Module      : Mdoc.Data.Positional
-- Copyright   : (c) 2026 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Mdoc.Data.Positional
  ( Positional (..)
  , Flag (..)
  , Flag1 (..)
  , Option (..)
  , Option1 (..)
  , Argument (..)
  , ShortArg (..)
  , LongArg (..)
  ) where

import Mdoc.Prelude

import Data.Char (isLower, toLower)
import Mdoc.Data.Argument
import Mdoc.Data.Flag
import Mdoc.Data.Option
import Mdoc.Pretty

data Positional
  = PositionalSwitch Flag
  | PositionalOption Option
  | PositionalArgument Argument
  deriving stock (Show)
  deriving (ToJSON) via (Rendered Positional)

instance Eq Positional where
  (==) = curry $ \case
    (PositionalSwitch f1, PositionalSwitch f2) -> f1 == f2
    (PositionalOption o1, PositionalOption o2) -> o1.flag == o2.flag
    (PositionalArgument a1, PositionalArgument a2) -> a1.schema == a2.schema
    _ -> False

instance Ord Positional where
  compare = curry $ \case
    (PositionalSwitch f1, PositionalSwitch f2) -> compareFlags f1 f2
    (PositionalOption o1, PositionalOption o2) -> compareFlags o1.flag o2.flag
    (PositionalArgument a1, PositionalArgument a2) -> comparing (.index) a1 a2
    (PositionalSwitch f, PositionalOption o) -> compareFlags f o.flag
    (PositionalOption o, PositionalSwitch f) -> compareFlags o.flag f
    (_, PositionalArgument {}) -> LT
    (PositionalArgument {}, _) -> GT

instance Pretty Positional where
  pretty = \case
    PositionalSwitch f -> pretty f
    PositionalOption o -> pretty o
    PositionalArgument a -> pretty a

compareFlags :: Flag -> Flag -> Ordering
compareFlags = comparing @(Int, String, Bool) $ \case
  --           1. short before long
  --           |  2. case-insensitive alphabetically
  --           |  |            3. upper before lower
  --           |  |            |
  Flag c _ -> (1, [toLower c], isLower c)
  GNUFlag s _ -> (2, map toLower s, False)