content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE UndecidableInstances #-}
  
  -- |
  -- SPDX-License-Identifier: BSD-3-Clause
  --
  -- Common pretty-printing infrastructure for the Swarm project.
  module Swarm.Pretty (
    -- * The 'PrettyPrec' class
    PrettyPrec (..),
  
    -- * Running pretty-printers
    ppr,
    prettyText,
    prettyTextWidth,
    prettyTextLine,
    prettyString,
    docToText,
    docToTextWidth,
    docToString,
  
    -- * Pretty-printing utilities
    pparens,
    pparens',
    encloseWithIndent,
    bquote,
    prettyShowLow,
    reportBug,
    BulletList (..),
    prettyBinding,
    prettyEquality,
    Wildcard (..),
  ) where
  
  import Control.Monad.Free
  import Data.Fix (Fix, unFix)
  import Data.Text (Text)
  import Prettyprinter
  import Prettyprinter.Render.String qualified as RS
  import Prettyprinter.Render.Text qualified as RT
  import Swarm.Util (showLowT)
  
  ------------------------------------------------------------
  -- PrettyPrec class + utilities
  
  -- | Type class for things that can be pretty-printed, given a
  --   precedence level of their context.
  class PrettyPrec a where
    prettyPrec :: Int -> a -> Doc ann -- can replace with custom ann type later if desired
  
  instance PrettyPrec Text where
    prettyPrec _ = pretty
  
  instance (PrettyPrec (t (Fix t))) => PrettyPrec (Fix t) where
    prettyPrec p = prettyPrec p . unFix
  
  instance (PrettyPrec (t (Free t v)), PrettyPrec v) => PrettyPrec (Free t v) where
    prettyPrec p (Free t) = prettyPrec p t
    prettyPrec p (Pure v) = prettyPrec p v
  
  -- | Pretty-print a thing, with a context precedence level of zero.
  ppr :: (PrettyPrec a) => a -> Doc ann
  ppr = prettyPrec 0
  
  -- | Render a pretty-printed document as @Text@.
  docToText :: Doc a -> Text
  docToText = RT.renderStrict . layoutPretty defaultLayoutOptions
  
  -- | Render a pretty-printed document as @Text@.
  --   This function consumes number of allowed characters in a
  --   line before introducing a line break. In other words, it
  --   expects the space of the layouter to be supplied.
  docToTextWidth :: Doc a -> Int -> Text
  docToTextWidth doc layoutWidth =
    RT.renderStrict $ layoutPretty (LayoutOptions (AvailablePerLine layoutWidth 1.0)) doc
  
  -- | Pretty-print something and render it as @Text@.
  prettyText :: (PrettyPrec a) => a -> Text
  prettyText = docToText . ppr
  
  -- | Pretty-print something and render it as @Text@.
  --   This is different than @prettyText@ in the sense that it also
  --   consumes number of allowed characters in a line before introducing
  --   a line break.
  prettyTextWidth :: (PrettyPrec a) => a -> Int -> Text
  prettyTextWidth = docToTextWidth . ppr
  
  -- | Pretty-print something and render it as (preferably) one line @Text@.
  prettyTextLine :: (PrettyPrec a) => a -> Text
  prettyTextLine = RT.renderStrict . layoutPretty (LayoutOptions Unbounded) . group . ppr
  
  -- | Render a pretty-printed document as a @String@.
  docToString :: Doc a -> String
  docToString = RS.renderString . layoutPretty defaultLayoutOptions
  
  -- | Pretty-print something and render it as a @String@.
  prettyString :: (PrettyPrec a) => a -> String
  prettyString = docToString . ppr
  
  -- | Optionally surround a document with parentheses depending on the
  --   @Bool@ argument and if it does not fit on line, indent the lines,
  --   with the parens on separate lines.
  pparens :: Bool -> Doc ann -> Doc ann
  pparens True = group . encloseWithIndent 2 lparen rparen
  pparens False = id
  
  -- | Same as pparens but does not indent the lines. Only encloses
  --   the document with parantheses.
  pparens' :: Bool -> Doc ann -> Doc ann
  pparens' True = group . enclose lparen rparen
  pparens' False = id
  
  encloseWithIndent :: Int -> Doc ann -> Doc ann -> Doc ann -> Doc ann
  encloseWithIndent i l r = nest i . enclose (l <> line') (nest (-2) $ line' <> r)
  
  -- | Surround a document with backticks.
  bquote :: Doc ann -> Doc ann
  bquote = group . enclose "`" "`"
  
  -- | Turn a 'Show' instance into a @Doc@, lowercasing it in the
  --   process.
  prettyShowLow :: Show a => a -> Doc ann
  prettyShowLow = pretty . showLowT
  
  -- | An invitation to report an error as a bug.
  reportBug :: Doc ann
  reportBug = "This should never happen; please report this as a bug: https://github.com/swarm-game/swarm/issues/new"
  
  --------------------------------------------------
  -- Bullet lists
  
  data BulletList i = BulletList
    { bulletListHeader :: forall a. Doc a
    , bulletListItems :: [i]
    }
  
  instance (PrettyPrec i) => PrettyPrec (BulletList i) where
    prettyPrec _ (BulletList hdr items) =
      nest 2 . vcat $ hdr : map (("-" <+>) . ppr) items
  
  --------------------------------------------------
  -- Term- and type-printing utilities: bindings, equalities, wildcards,
  -- etc.
  
  prettyBinding :: (PrettyPrec a, PrettyPrec b) => (a, b) -> Doc ann
  prettyBinding (x, ty) = ppr x <> ":" <+> ppr ty
  
  prettyEquality :: (PrettyPrec a, PrettyPrec b) => (a, Maybe b) -> Doc ann
  prettyEquality (x, Nothing) = ppr x
  prettyEquality (x, Just t) = ppr x <+> "=" <+> ppr t
  
  -- | We can use the 'Wildcard' value to replace unification variables
  --   when we don't care about them, e.g. to print out the shape of a
  --   type like @(_ -> _) * _@
  data Wildcard = Wildcard
    deriving (Eq, Ord, Show)
  
  instance PrettyPrec Wildcard where
    prettyPrec _ _ = "_"
  