Described.hs

-- |
--
-- Module      : Mdoc.Data.Described
-- Copyright   : (c) 2026 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Mdoc.Data.Described
  ( Described (..)
  , required
  , redescribe
  , setHelpText
  , textToMdoc
  ) where

import Mdoc.Prelude

import Data.Aeson (object, (.=))
import Data.Function (on)
import Data.Text qualified as T
import Mdoc.Data.Optionality
import Mdoc.Optics
import Mdoc.Pretty
import Mdoc.Syntax

data Described a = Described
  { item :: a
  , optionality :: Optionality
  , multiple :: Bool
  , help :: Maybe Mdoc
  }
  deriving stock (Functor, Generic, Show)

instance Eq a => Eq (Described a) where
  (==) = (==) `on` (.item)

instance Ord a => Ord (Described a) where
  compare = comparing (.item)

instance Pretty a => Pretty (Described a) where
  pretty d =
    vsep
      $ catMaybes
        [ Just $ ".It" <+> pretty d.item
        , pretty <$> d.help
        ]

instance ToJSON a => ToJSON (Described a) where
  toJSON d =
    object
      [ "head" .= d.item
      , "body" .= d.help
      ]

-- | Describe an item as 'Required', singular, without help
required :: a -> Described a
required item =
  Described
    { item
    , optionality = Required
    , multiple = False
    , help = Nothing
    }

-- | Concat a described list into a single item
--
-- NB. The element descriptions are discarded and 'required' is used. We could
-- get clever (e.g. any required -> required, concatenat help, etc) but it's
-- just not useful in the project to do so.
redescribe :: ([a] -> b) -> [Described a] -> Described b
redescribe f = required . f . map (.item)

setHelp :: Mdoc -> Described a -> Described a
setHelp x = field @"help" ?~ x

-- | Set a 'Described's 'helpLines' from a 'Text'
setHelpText :: Text -> Described a -> Described a
setHelpText = maybe id setHelp . textToMdoc

textToMdoc :: Text -> Maybe Mdoc
textToMdoc =
  fmap
    ( Mdoc
        . intersperse (MacroLine Pp [])
        . map (TextLine . esc)
        . toList
    )
    . nonEmpty
    . T.lines