{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- Module      : Aihc.Parser.Pretty
-- Description : Pretty-printing of AST to Haskell source code
--
-- This module provides pretty-printing of parsed AST back to valid Haskell
-- source code. It is used for round-trip testing and code generation.
--
-- The 'Pretty' instances from 'Prettyprinter' are provided for the main
-- AST types, allowing direct use of 'pretty' from @Prettyprinter@.
--
-- This module has an empty export list because it only provides typeclass
-- instances. Import it to bring the 'Pretty' instances into scope.
--
-- __Provided instances:__ 'Pretty' for 'Module', 'Expr', 'Pattern', 'Type'.
module Aihc.Parser.Pretty
  (
  )
where

import Aihc.Parser.Syntax
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Data.Text qualified as T
import Prettyprinter
  ( Doc,
    Pretty (pretty),
    braces,
    brackets,
    comma,
    hsep,
    parens,
    punctuate,
    semi,
    vsep,
    (<+>),
  )

-- | Pretty instance for Module - renders to valid Haskell source code.
instance Pretty Module where
  pretty :: forall ann. Module -> Doc ann
pretty = Module -> Doc ann
forall ann. Module -> Doc ann
prettyModuleDoc

-- | Pretty instance for Expr - renders to valid Haskell source code.
instance Pretty Expr where
  pretty :: forall ann. Expr -> Doc ann
pretty = Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0

-- | Pretty instance for Pattern - renders to valid Haskell source code.
instance Pretty Pattern where
  pretty :: forall ann. Pattern -> Doc ann
pretty = Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern

-- | Pretty instance for Type - renders to valid Haskell source code.
instance Pretty Type where
  pretty :: forall ann. Type -> Doc ann
pretty = Type -> Doc ann
forall ann. Type -> Doc ann
prettyType

prettyModuleDoc :: Module -> Doc ann
prettyModuleDoc :: forall ann. Module -> Doc ann
prettyModuleDoc Module
modu =
  [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann]
forall {ann}. [Doc ann]
pragmaLines [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann]
forall {ann}. [Doc ann]
headerLines [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann]
forall {ann}. [Doc ann]
importLines [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann]
forall {ann}. [Doc ann]
declLines)
  where
    pragmaLines :: [Doc ann]
pragmaLines =
      (ExtensionSetting -> Doc ann) -> [ExtensionSetting] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map
        (\ExtensionSetting
ext -> Doc ann
"{-# LANGUAGE" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (ExtensionSetting -> Text
extensionSettingName ExtensionSetting
ext) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"#-}")
        (Module -> [ExtensionSetting]
moduleLanguagePragmas Module
modu)
    headerLines :: [Doc ann]
headerLines =
      case Module -> Maybe Text
moduleName Module
modu of
        Just Text
name ->
          [ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
              ( [Doc ann
"module", Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name]
                  [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann]
-> (WarningText -> [Doc ann]) -> Maybe WarningText -> [Doc ann]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] WarningText -> [Doc ann]
forall {ann}. WarningText -> [Doc ann]
prettyWarningText (Module -> Maybe WarningText
moduleWarningText Module
modu)
                  [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann]
-> ([ExportSpec] -> [Doc ann]) -> Maybe [ExportSpec] -> [Doc ann]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\[ExportSpec]
specs -> [[ExportSpec] -> Doc ann
forall ann. [ExportSpec] -> Doc ann
prettyExportSpecList [ExportSpec]
specs]) (Module -> Maybe [ExportSpec]
moduleExports Module
modu)
                  [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann
"where"]
              )
          ]
        Maybe Text
Nothing -> []
    prettyWarningText :: WarningText -> [Doc ann]
prettyWarningText (DeprText SourceSpan
_ Text
msg) = [Doc ann
"{-# DEPRECATED", String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> String
forall a. Show a => a -> String
show Text
msg), Doc ann
"#-}"]
    prettyWarningText (WarnText SourceSpan
_ Text
msg) = [Doc ann
"{-# WARNING", String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> String
forall a. Show a => a -> String
show Text
msg), Doc ann
"#-}"]
    importLines :: [Doc ann]
importLines = (ImportDecl -> Doc ann) -> [ImportDecl] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl -> Doc ann
forall ann. ImportDecl -> Doc ann
prettyImportDecl (Module -> [ImportDecl]
moduleImports Module
modu)
    declLines :: [Doc ann]
declLines = (Decl -> [Doc ann]) -> [Decl] -> [Doc ann]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl -> [Doc ann]
forall ann. Decl -> [Doc ann]
prettyDeclLines (Module -> [Decl]
moduleDecls Module
modu)

prettyExportSpecList :: [ExportSpec] -> Doc ann
prettyExportSpecList :: forall ann. [ExportSpec] -> Doc ann
prettyExportSpecList [ExportSpec]
specs =
  Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((ExportSpec -> Doc ann) -> [ExportSpec] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ExportSpec -> Doc ann
forall ann. ExportSpec -> Doc ann
prettyExportSpec [ExportSpec]
specs)))

prettyExportSpec :: ExportSpec -> Doc ann
prettyExportSpec :: forall ann. ExportSpec -> Doc ann
prettyExportSpec ExportSpec
spec =
  case ExportSpec
spec of
    ExportModule SourceSpan
_ Text
modName -> Doc ann
"module" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
modName
    ExportVar SourceSpan
_ Maybe Text
namespace Text
name -> Maybe Text -> Doc ann
forall ann. Maybe Text -> Doc ann
prettyNamespacePrefix Maybe Text
namespace Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
prettyBinderName Text
name
    ExportAbs SourceSpan
_ Maybe Text
namespace Text
name -> Maybe Text -> Doc ann
forall ann. Maybe Text -> Doc ann
prettyNamespacePrefix Maybe Text
namespace Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
prettyConstructorName Text
name
    ExportAll SourceSpan
_ Maybe Text
namespace Text
name -> Maybe Text -> Doc ann
forall ann. Maybe Text -> Doc ann
prettyNamespacePrefix Maybe Text
namespace Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
prettyConstructorName Text
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"(..)"
    ExportWith SourceSpan
_ Maybe Text
namespace Text
name [Text]
members ->
      Maybe Text -> Doc ann
forall ann. Maybe Text -> Doc ann
prettyNamespacePrefix Maybe Text
namespace Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
prettyConstructorName Text
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall ann. Text -> Doc ann
prettyBinderName [Text]
members)))

prettyImportDecl :: ImportDecl -> Doc ann
prettyImportDecl :: forall ann. ImportDecl -> Doc ann
prettyImportDecl ImportDecl
decl =
  let renderPostQualified :: Bool
renderPostQualified =
        ImportDecl -> Bool
importDeclQualifiedPost ImportDecl
decl
          Bool -> Bool -> Bool
&& ImportDecl -> Bool
importDeclQualified ImportDecl
decl
   in [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
        ( [Doc ann
"import"]
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann
"qualified" | ImportDecl -> Bool
importDeclQualified ImportDecl
decl Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
renderPostQualified]
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann]
-> (ImportLevel -> [Doc ann]) -> Maybe ImportLevel -> [Doc ann]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ImportLevel
level -> [ImportLevel -> Doc ann
forall ann. ImportLevel -> Doc ann
prettyImportLevel ImportLevel
level]) (ImportDecl -> Maybe ImportLevel
importDeclLevel ImportDecl
decl)
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> (Text -> [Doc ann]) -> Maybe Text -> [Doc ann]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
pkg -> [Text -> Doc ann
forall ann. Text -> Doc ann
prettyQuotedText Text
pkg]) (ImportDecl -> Maybe Text
importDeclPackage ImportDecl
decl)
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (ImportDecl -> Text
importDeclModule ImportDecl
decl)]
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann
"qualified" | ImportDecl -> Bool
importDeclQualified ImportDecl
decl Bool -> Bool -> Bool
&& Bool
renderPostQualified]
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> (Text -> [Doc ann]) -> Maybe Text -> [Doc ann]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
alias -> [Doc ann
"as", Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
alias]) (ImportDecl -> Maybe Text
importDeclAs ImportDecl
decl)
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann]
-> (ImportSpec -> [Doc ann]) -> Maybe ImportSpec -> [Doc ann]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ImportSpec
spec -> [ImportSpec -> Doc ann
forall ann. ImportSpec -> Doc ann
prettyImportSpec ImportSpec
spec]) (ImportDecl -> Maybe ImportSpec
importDeclSpec ImportDecl
decl)
        )

prettyImportLevel :: ImportLevel -> Doc ann
prettyImportLevel :: forall ann. ImportLevel -> Doc ann
prettyImportLevel ImportLevel
level =
  case ImportLevel
level of
    ImportLevel
ImportLevelQuote -> Doc ann
"quote"
    ImportLevel
ImportLevelSplice -> Doc ann
"splice"

prettyQuotedText :: Text -> Doc ann
prettyQuotedText :: forall ann. Text -> Doc ann
prettyQuotedText Text
txt = Doc ann
"\"" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
txt Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\""

prettyImportSpec :: ImportSpec -> Doc ann
prettyImportSpec :: forall ann. ImportSpec -> Doc ann
prettyImportSpec ImportSpec
spec =
  [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
    ( [Doc ann
"hiding" | ImportSpec -> Bool
importSpecHiding ImportSpec
spec]
        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((ImportItem -> Doc ann) -> [ImportItem] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ImportItem -> Doc ann
forall ann. ImportItem -> Doc ann
prettyImportItem (ImportSpec -> [ImportItem]
importSpecItems ImportSpec
spec))))]
    )

prettyImportItem :: ImportItem -> Doc ann
prettyImportItem :: forall ann. ImportItem -> Doc ann
prettyImportItem ImportItem
item =
  case ImportItem
item of
    ImportItemVar SourceSpan
_ Maybe Text
namespace Text
name -> Maybe Text -> Doc ann
forall ann. Maybe Text -> Doc ann
prettyNamespacePrefix Maybe Text
namespace Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
prettyBinderName Text
name
    ImportItemAbs SourceSpan
_ Maybe Text
namespace Text
name -> Maybe Text -> Doc ann
forall ann. Maybe Text -> Doc ann
prettyNamespacePrefix Maybe Text
namespace Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
prettyConstructorName Text
name
    ImportItemAll SourceSpan
_ Maybe Text
namespace Text
name -> Maybe Text -> Doc ann
forall ann. Maybe Text -> Doc ann
prettyNamespacePrefix Maybe Text
namespace Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
prettyConstructorName Text
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"(..)"
    ImportItemWith SourceSpan
_ Maybe Text
namespace Text
name [Text]
members ->
      Maybe Text -> Doc ann
forall ann. Maybe Text -> Doc ann
prettyNamespacePrefix Maybe Text
namespace Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
prettyConstructorName Text
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall ann. Text -> Doc ann
prettyBinderName [Text]
members)))

prettyNamespacePrefix :: Maybe Text -> Doc ann
prettyNamespacePrefix :: forall ann. Maybe Text -> Doc ann
prettyNamespacePrefix Maybe Text
namespace =
  case Maybe Text
namespace of
    Just Text
ns -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
ns Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" "
    Maybe Text
Nothing -> Doc ann
forall a. Monoid a => a
mempty

prettyDeclLines :: Decl -> [Doc ann]
prettyDeclLines :: forall ann. Decl -> [Doc ann]
prettyDeclLines Decl
decl =
  case Decl
decl of
    DeclValue SourceSpan
_ ValueDecl
valueDecl -> ValueDecl -> [Doc ann]
forall ann. ValueDecl -> [Doc ann]
prettyValueDeclLines ValueDecl
valueDecl
    DeclTypeSig SourceSpan
_ [Text]
names Type
ty -> [[Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep [[Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall ann. Text -> Doc ann
prettyBinderName [Text]
names)), Doc ann
"::", Type -> Doc ann
forall ann. Type -> Doc ann
prettyType Type
ty]]
    DeclStandaloneKindSig SourceSpan
_ Text
name Type
kind -> [[Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep [Doc ann
"type", Text -> Doc ann
forall ann. Text -> Doc ann
prettyConstructorName Text
name, Doc ann
"::", Type -> Doc ann
forall ann. Type -> Doc ann
prettyType Type
kind]]
    DeclFixity SourceSpan
_ FixityAssoc
assoc Maybe Int
prec [Text]
ops ->
      [ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
          ( [FixityAssoc -> Doc ann
forall ann. FixityAssoc -> Doc ann
prettyFixityAssoc FixityAssoc
assoc]
              [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> (Int -> [Doc ann]) -> Maybe Int -> [Doc ann]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc ann -> [Doc ann]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc ann -> [Doc ann]) -> (Int -> Doc ann) -> Int -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> (Int -> String) -> Int -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) Maybe Int
prec
              [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> (Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall ann. Text -> Doc ann
prettyInfixOp [Text]
ops
          )
      ]
    DeclTypeSyn SourceSpan
_ TypeSynDecl
synDecl ->
      [ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
          [ Doc ann
"type",
            Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (TypeSynDecl -> Text
typeSynName TypeSynDecl
synDecl),
            [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ((TyVarBinder -> Doc ann) -> [TyVarBinder] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBinder -> Doc ann
forall ann. TyVarBinder -> Doc ann
prettyTyVarBinder (TypeSynDecl -> [TyVarBinder]
typeSynParams TypeSynDecl
synDecl)),
            Doc ann
"=",
            Type -> Doc ann
forall ann. Type -> Doc ann
prettyType (TypeSynDecl -> Type
typeSynBody TypeSynDecl
synDecl)
          ]
      ]
    DeclData SourceSpan
_ DataDecl
dataDecl -> [DataDecl -> Doc ann
forall ann. DataDecl -> Doc ann
prettyDataDecl DataDecl
dataDecl]
    DeclNewtype SourceSpan
_ NewtypeDecl
newtypeDecl -> [NewtypeDecl -> Doc ann
forall ann. NewtypeDecl -> Doc ann
prettyNewtypeDecl NewtypeDecl
newtypeDecl]
    DeclClass SourceSpan
_ ClassDecl
classDecl -> [ClassDecl -> Doc ann
forall ann. ClassDecl -> Doc ann
prettyClassDecl ClassDecl
classDecl]
    DeclInstance SourceSpan
_ InstanceDecl
instanceDecl -> [InstanceDecl -> Doc ann
forall ann. InstanceDecl -> Doc ann
prettyInstanceDecl InstanceDecl
instanceDecl]
    DeclStandaloneDeriving SourceSpan
_ StandaloneDerivingDecl
derivingDecl -> [StandaloneDerivingDecl -> Doc ann
forall ann. StandaloneDerivingDecl -> Doc ann
prettyStandaloneDeriving StandaloneDerivingDecl
derivingDecl]
    DeclDefault SourceSpan
_ [Type]
tys -> [Doc ann
"default" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Type -> Doc ann) -> [Type] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Doc ann
forall ann. Type -> Doc ann
prettyType [Type]
tys)))]
    DeclForeign SourceSpan
_ ForeignDecl
foreignDecl -> [ForeignDecl -> Doc ann
forall ann. ForeignDecl -> Doc ann
prettyForeignDecl ForeignDecl
foreignDecl]

prettyValueDeclLines :: ValueDecl -> [Doc ann]
prettyValueDeclLines :: forall ann. ValueDecl -> [Doc ann]
prettyValueDeclLines ValueDecl
valueDecl =
  case ValueDecl
valueDecl of
    PatternBind SourceSpan
_ Pattern
pat Rhs
rhs -> [Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Rhs -> Doc ann
forall ann. Rhs -> Doc ann
prettyRhs Rhs
rhs]
    FunctionBind SourceSpan
_ Text
name [Match]
matches ->
      (Match -> [Doc ann]) -> [Match] -> [Doc ann]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> Match -> [Doc ann]
forall ann. Text -> Match -> [Doc ann]
prettyFunctionMatchLines Text
name) [Match]
matches

-- | Pretty-print a value declaration on a single line.
-- For function binds with multiple matches, each match becomes a semicolon-separated item.
-- For function binds with guards, the guards are space-separated.
prettyValueDeclSingleLine :: ValueDecl -> Doc ann
prettyValueDeclSingleLine :: forall ann. ValueDecl -> Doc ann
prettyValueDeclSingleLine ValueDecl
valueDecl =
  case ValueDecl
valueDecl of
    PatternBind SourceSpan
_ Pattern
pat Rhs
rhs -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Rhs -> Doc ann
forall ann. Rhs -> Doc ann
prettyRhs Rhs
rhs
    FunctionBind SourceSpan
_ Text
name [Match]
matches ->
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi ((Match -> Doc ann) -> [Match] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Match -> Doc ann
forall ann. Text -> Match -> Doc ann
prettyFunctionMatch Text
name) [Match]
matches))

prettyFunctionMatchLines :: Text -> Match -> [Doc ann]
prettyFunctionMatchLines :: forall ann. Text -> Match -> [Doc ann]
prettyFunctionMatchLines Text
name Match
match =
  case Match -> Rhs
matchRhs Match
match of
    UnguardedRhs SourceSpan
_ Expr
_ -> [Text -> Match -> Doc ann
forall ann. Text -> Match -> Doc ann
prettyFunctionMatch Text
name Match
match]
    GuardedRhss SourceSpan
_ [GuardedRhs]
grhss ->
      Text -> [Pattern] -> Doc ann
forall ann. Text -> [Pattern] -> Doc ann
prettyFunctionHead Text
name (Match -> [Pattern]
matchPats Match
match)
        Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [ Doc ann
"  |"
              Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((GuardQualifier -> Doc ann) -> [GuardQualifier] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map GuardQualifier -> Doc ann
forall ann. GuardQualifier -> Doc ann
prettyGuardQualifier (GuardedRhs -> [GuardQualifier]
guardedRhsGuards GuardedRhs
grhs)))
              Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"="
              Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 (GuardedRhs -> Expr
guardedRhsBody GuardedRhs
grhs)
          | GuardedRhs
grhs <- [GuardedRhs]
grhss
          ]

prettyFunctionMatch :: Text -> Match -> Doc ann
prettyFunctionMatch :: forall ann. Text -> Match -> Doc ann
prettyFunctionMatch Text
name Match
match =
  Text -> [Pattern] -> Doc ann
forall ann. Text -> [Pattern] -> Doc ann
prettyFunctionHead Text
name (Match -> [Pattern]
matchPats Match
match) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Rhs -> Doc ann
forall ann. Rhs -> Doc ann
prettyRhs (Match -> Rhs
matchRhs Match
match)

prettyFunctionHead :: Text -> [Pattern] -> Doc ann
prettyFunctionHead :: forall ann. Text -> [Pattern] -> Doc ann
prettyFunctionHead Text
name [Pattern]
pats =
  case [Pattern]
pats of
    [Pattern
lhs, Pattern
rhsPat]
      | Text -> Bool
isOperatorToken Text
name ->
          Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
lhs Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
rhsPat
    [Pattern]
_ ->
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Text -> Doc ann
forall ann. Text -> Doc ann
prettyFunctionBinder Text
name Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Pattern -> Doc ann) -> [Pattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern [Pattern]
pats)

prettyRhs :: Rhs -> Doc ann
prettyRhs :: forall ann. Rhs -> Doc ann
prettyRhs Rhs
rhs =
  case Rhs
rhs of
    -- For UnguardedRhs, nothing follows the expression, so no parens needed
    UnguardedRhs SourceSpan
_ Expr
expr -> Doc ann
"=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
expr
    -- For GuardedRhss, multiple guards can follow, but brace-terminated
    -- expressions (do, case, \case) are safe. Open-ended expressions
    -- (if, lambda, let, where) could capture trailing guards with layout,
    -- but our pretty-printer doesn't use layout for guards.
    GuardedRhss SourceSpan
_ [GuardedRhs]
guards ->
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
        [ Doc ann
"|"
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((GuardQualifier -> Doc ann) -> [GuardQualifier] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map GuardQualifier -> Doc ann
forall ann. GuardQualifier -> Doc ann
prettyGuardQualifier (GuardedRhs -> [GuardQualifier]
guardedRhsGuards GuardedRhs
grhs)))
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"="
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 (GuardedRhs -> Expr
guardedRhsBody GuardedRhs
grhs)
        | GuardedRhs
grhs <- [GuardedRhs]
guards
        ]

prettyType :: Type -> Doc ann
prettyType :: forall ann. Type -> Doc ann
prettyType = Int -> Type -> Doc ann
forall ann. Int -> Type -> Doc ann
prettyTypePrec Int
0

-- | Type context for parenthesization decisions.
-- CtxTypeFunArg: LHS of -> or function position of type application (same rules).
-- CtxTypeAppArg: argument position of type application.
-- CtxTypeAtom: must be syntactically atomic (e.g., constraint args, instance heads).
data TypeCtx
  = CtxTypeFunArg
  | CtxTypeAppArg
  | CtxTypeAtom

prettyTypeIn :: TypeCtx -> Type -> Doc ann
prettyTypeIn :: forall ann. TypeCtx -> Type -> Doc ann
prettyTypeIn TypeCtx
ctx Type
ty =
  Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize (TypeCtx -> Type -> Bool
needsTypeParens TypeCtx
ctx Type
ty) (Int -> Type -> Doc ann
forall ann. Int -> Type -> Doc ann
prettyTypePrec Int
0 Type
ty)

needsTypeParens :: TypeCtx -> Type -> Bool
needsTypeParens :: TypeCtx -> Type -> Bool
needsTypeParens TypeCtx
ctx Type
ty =
  case TypeCtx
ctx of
    TypeCtx
CtxTypeFunArg ->
      case Type
ty of
        TForall {} -> Bool
True
        TFun {} -> Bool
True
        TContext {} -> Bool
True
        Type
_ -> Bool
False
    TypeCtx
CtxTypeAppArg ->
      case Type
ty of
        TApp SourceSpan
_ (TApp SourceSpan
_ (TCon SourceSpan
_ Text
op TypePromotion
_) Type
_) Type
_
          | Text -> Bool
isSymbolicTypeOperator Text
op Bool -> Bool -> Bool
&& Text
op Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"->" -> Bool
False
        TQuasiQuote {} -> Bool
False
        TApp {} -> Bool
True
        TForall {} -> Bool
True
        TFun {} -> Bool
True
        TContext {} -> Bool
True
        Type
_ -> Bool
False
    TypeCtx
CtxTypeAtom ->
      case Type
ty of
        TVar {} -> Bool
False
        TCon {} -> Bool
False
        TTypeLit {} -> Bool
False
        TStar {} -> Bool
False
        TQuasiQuote {} -> Bool
False
        TList {} -> Bool
False
        TTuple {} -> Bool
False
        TParen {} -> Bool
False
        Type
_ -> Bool
True

prettyTypePrec :: Int -> Type -> Doc ann
prettyTypePrec :: forall ann. Int -> Type -> Doc ann
prettyTypePrec Int
prec Type
ty =
  case Type
ty of
    TVar SourceSpan
_ Text
name -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name
    TCon SourceSpan
_ Text
name TypePromotion
promoted ->
      let base :: Doc ann
base
            | Text -> Bool
isSymbolicTypeOperator Text
name = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name)
            | Bool
otherwise = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name
       in if TypePromotion
promoted TypePromotion -> TypePromotion -> Bool
forall a. Eq a => a -> a -> Bool
== TypePromotion
Promoted then Doc ann
"'" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
base else Doc ann
forall ann. Doc ann
base
    TTypeLit SourceSpan
_ TypeLiteral
lit -> TypeLiteral -> Doc ann
forall ann. TypeLiteral -> Doc ann
prettyTypeLiteral TypeLiteral
lit
    TStar SourceSpan
_ -> Doc ann
"*"
    TQuasiQuote SourceSpan
_ Text
quoter Text
body -> Text -> Text -> Doc ann
forall ann. Text -> Text -> Doc ann
prettyQuasiQuote Text
quoter Text
body
    TForall SourceSpan
_ [Text]
binders Type
inner ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize
        (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
        (Doc ann
"forall" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ((Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty [Text]
binders) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"." Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Type -> Doc ann
forall ann. Int -> Type -> Doc ann
prettyTypePrec Int
0 Type
inner)
    TApp SourceSpan
_ (TApp SourceSpan
_ (TCon SourceSpan
_ Text
op TypePromotion
_) Type
lhs) Type
rhs
      | Text -> Bool
isSymbolicTypeOperator Text
op Bool -> Bool -> Bool
&& Text
op Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"->" ->
          Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Int -> Type -> Doc ann
forall ann. Int -> Type -> Doc ann
prettyTypePrec Int
0 Type
lhs Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
op Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Type -> Doc ann
forall ann. Int -> Type -> Doc ann
prettyTypePrec Int
0 Type
rhs)
    TApp SourceSpan
_ Type
f Type
x ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize
        (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2)
        (TypeCtx -> Type -> Doc ann
forall ann. TypeCtx -> Type -> Doc ann
prettyTypeIn TypeCtx
CtxTypeFunArg Type
f Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeCtx -> Type -> Doc ann
forall ann. TypeCtx -> Type -> Doc ann
prettyTypeIn TypeCtx
CtxTypeAppArg Type
x)
    TFun SourceSpan
_ Type
a Type
b ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize
        (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
        (TypeCtx -> Type -> Doc ann
forall ann. TypeCtx -> Type -> Doc ann
prettyTypeIn TypeCtx
CtxTypeFunArg Type
a Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Type -> Doc ann
forall ann. Int -> Type -> Doc ann
prettyTypePrec Int
0 Type
b)
    TTuple SourceSpan
_ TypePromotion
promoted [Type]
elems ->
      let tupleDoc :: Doc ann
tupleDoc = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Type -> Doc ann) -> [Type] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Type -> Doc ann
forall ann. Int -> Type -> Doc ann
prettyTypePrec Int
0) [Type]
elems)))
       in if TypePromotion
promoted TypePromotion -> TypePromotion -> Bool
forall a. Eq a => a -> a -> Bool
== TypePromotion
Promoted then Doc ann
"'" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
tupleDoc else Doc ann
forall ann. Doc ann
tupleDoc
    TList SourceSpan
_ TypePromotion
promoted Type
inner ->
      let listDoc :: Doc ann
listDoc = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Int -> Type -> Doc ann
forall ann. Int -> Type -> Doc ann
prettyTypePrec Int
0 Type
inner)
       in if TypePromotion
promoted TypePromotion -> TypePromotion -> Bool
forall a. Eq a => a -> a -> Bool
== TypePromotion
Promoted then Doc ann
"'" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
listDoc else Doc ann
forall ann. Doc ann
listDoc
    TParen SourceSpan
_ Type
inner
      | Type -> Bool
isInfixTypeApp Type
inner -> Int -> Type -> Doc ann
forall ann. Int -> Type -> Doc ann
prettyTypePrec Int
prec Type
inner
      | Bool
otherwise -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Int -> Type -> Doc ann
forall ann. Int -> Type -> Doc ann
prettyTypePrec Int
0 Type
inner)
    TContext SourceSpan
_ [Constraint]
constraints Type
inner ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize
        (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
        ([Constraint] -> Doc ann
forall ann. [Constraint] -> Doc ann
prettyContext [Constraint]
constraints Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=>" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Type -> Doc ann
forall ann. Int -> Type -> Doc ann
prettyTypePrec Int
0 Type
inner)

prettyContext :: [Constraint] -> Doc ann
prettyContext :: forall ann. [Constraint] -> Doc ann
prettyContext [Constraint]
constraints =
  case [Constraint]
constraints of
    [Constraint
single] -> Constraint -> Doc ann
forall ann. Constraint -> Doc ann
prettyConstraint Constraint
single
    [Constraint]
_ -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Constraint -> Doc ann) -> [Constraint] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Constraint -> Doc ann
forall ann. Constraint -> Doc ann
prettyConstraint [Constraint]
constraints)))

prettyConstraint :: Constraint -> Doc ann
prettyConstraint :: forall ann. Constraint -> Doc ann
prettyConstraint Constraint
constraint =
  let base :: Doc ann
base =
        if Constraint -> Text
constraintClass Constraint
constraint Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"()" Bool -> Bool -> Bool
&& [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Constraint -> [Type]
constraintArgs Constraint
constraint)
          then Doc ann
"()"
          else [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (Constraint -> Text
constraintClass Constraint
constraint) Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Type -> Doc ann) -> [Type] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (TypeCtx -> Type -> Doc ann
forall ann. TypeCtx -> Type -> Doc ann
prettyTypeIn TypeCtx
CtxTypeAtom) (Constraint -> [Type]
constraintArgs Constraint
constraint))
   in if Constraint -> Bool
constraintParen Constraint
constraint
        then Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens Doc ann
forall ann. Doc ann
base
        else Doc ann
forall ann. Doc ann
base

isSymbolicTypeOperator :: Text -> Bool
isSymbolicTypeOperator :: Text -> Bool
isSymbolicTypeOperator Text
op =
  case Text -> Maybe (Char, Text)
T.uncons Text
op of
    Maybe (Char, Text)
Nothing -> Bool
False
    Just (Char, Text)
_ -> (Char -> Bool) -> Text -> Bool
T.all (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
":!#$%&*+./<=>?\\^|-~" :: String)) Text
op

isInfixTypeApp :: Type -> Bool
isInfixTypeApp :: Type -> Bool
isInfixTypeApp Type
ty =
  case Type
ty of
    TApp SourceSpan
_ (TApp SourceSpan
_ (TCon SourceSpan
_ Text
op TypePromotion
_) Type
_) Type
_ -> Text -> Bool
isSymbolicTypeOperator Text
op Bool -> Bool -> Bool
&& Text
op Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"->"
    Type
_ -> Bool
False

prettyTypeLiteral :: TypeLiteral -> Doc ann
prettyTypeLiteral :: forall ann. TypeLiteral -> Doc ann
prettyTypeLiteral TypeLiteral
lit =
  case TypeLiteral
lit of
    TypeLitInteger Integer
_ Text
repr -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
repr
    TypeLitSymbol Text
_ Text
repr -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
repr
    TypeLitChar Char
_ Text
repr -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
repr

prettyPattern :: Pattern -> Doc ann
prettyPattern :: forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat =
  case Pattern
pat of
    PVar SourceSpan
_ Text
name -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name
    PWildcard SourceSpan
_ -> Doc ann
"_"
    PLit SourceSpan
_ Literal
lit -> Literal -> Doc ann
forall ann. Literal -> Doc ann
prettyLiteral Literal
lit
    PQuasiQuote SourceSpan
_ Text
quoter Text
body -> Text -> Text -> Doc ann
forall ann. Text -> Text -> Doc ann
prettyQuasiQuote Text
quoter Text
body
    PTuple SourceSpan
_ [Pattern]
elems -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Pattern -> Doc ann) -> [Pattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern [Pattern]
elems)))
    PList SourceSpan
_ [Pattern]
elems -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Pattern -> Doc ann) -> [Pattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern [Pattern]
elems)))
    PCon SourceSpan
_ Text
con [Pattern]
args -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
con Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Pattern -> Doc ann) -> [Pattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPatternAtom [Pattern]
args)
    PInfix SourceSpan
_ Pattern
lhs Text
op Pattern
rhs -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPatternAtom Pattern
lhs Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
prettyInfixOp Text
op Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPatternAtom Pattern
rhs
    PView SourceSpan
_ Expr
viewExpr Pattern
inner -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
viewExpr Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
inner)
    PAs SourceSpan
_ Text
name Pattern
inner -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"@" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPatternAtomStrict Pattern
inner
    PStrict SourceSpan
_ Pattern
inner -> Doc ann
"!" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPatternAtomStrict Pattern
inner
    PIrrefutable SourceSpan
_ Pattern
inner -> Doc ann
"~" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPatternAtomStrict Pattern
inner
    PNegLit SourceSpan
_ Literal
lit -> Doc ann
"-" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Literal -> Doc ann
forall ann. Literal -> Doc ann
prettyLiteral Literal
lit
    PParen SourceSpan
_ Pattern
inner -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
inner)
    PRecord SourceSpan
_ Text
con [(Text, Pattern)]
fields ->
      Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
con
        Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces
          ( [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
              ( Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate
                  Doc ann
forall ann. Doc ann
comma
                  [Text -> Pattern -> Doc ann
forall ann. Text -> Pattern -> Doc ann
prettyPatternFieldBinding Text
fieldName Pattern
fieldPat | (Text
fieldName, Pattern
fieldPat) <- [(Text, Pattern)]
fields]
              )
          )

-- | Pretty print a pattern field binding.
-- Supports NamedFieldPuns: if pattern is a variable with the same name as the field,
-- print just the field name (punned form).
prettyPatternFieldBinding :: Text -> Pattern -> Doc ann
prettyPatternFieldBinding :: forall ann. Text -> Pattern -> Doc ann
prettyPatternFieldBinding Text
fieldName Pattern
fieldPat =
  case Pattern
fieldPat of
    PVar SourceSpan
_ Text
varName | Text
varName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
fieldName -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
fieldName -- NamedFieldPuns: punned form
    Pattern
_ -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
fieldName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
fieldPat

prettyPatternAtom :: Pattern -> Doc ann
prettyPatternAtom :: forall ann. Pattern -> Doc ann
prettyPatternAtom Pattern
pat =
  case Pattern
pat of
    PVar SourceSpan
_ Text
_ -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat
    PWildcard SourceSpan
_ -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat
    PLit SourceSpan
_ Literal
_ -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat
    PQuasiQuote {} -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat
    PNegLit SourceSpan
_ Literal
_ -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat
    PList SourceSpan
_ [Pattern]
_ -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat
    PTuple SourceSpan
_ [Pattern]
_ -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat
    PParen SourceSpan
_ Pattern
_ -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat
    PStrict SourceSpan
_ Pattern
_ -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat
    PView {} -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat
    Pattern
_ -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat)

-- | Pretty print a pattern atom after @ or as the operand of ! or ~.
-- Negative literals and nested strictness/irrefutability need parens.
prettyPatternAtomStrict :: Pattern -> Doc ann
prettyPatternAtomStrict :: forall ann. Pattern -> Doc ann
prettyPatternAtomStrict Pattern
pat =
  case Pattern
pat of
    PNegLit {} -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat)
    PStrict {} -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat)
    PIrrefutable {} -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat)
    Pattern
_ -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPatternAtom Pattern
pat

prettyLiteral :: Literal -> Doc ann
prettyLiteral :: forall ann. Literal -> Doc ann
prettyLiteral Literal
lit =
  case Literal
lit of
    LitInt SourceSpan
_ Integer
_ Text
repr -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
repr
    LitIntBase SourceSpan
_ Integer
_ Text
repr -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
repr
    LitFloat SourceSpan
_ Double
_ Text
repr -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
repr
    LitChar SourceSpan
_ Char
_ Text
repr -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
repr
    LitString SourceSpan
_ Text
_ Text
repr -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
repr

prettyDataDecl :: DataDecl -> Doc ann
prettyDataDecl :: forall ann. DataDecl -> Doc ann
prettyDataDecl DataDecl
decl =
  [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
    ( [ Doc ann
"data",
        [Constraint] -> Text -> [TyVarBinder] -> Doc ann
forall ann. [Constraint] -> Text -> [TyVarBinder] -> Doc ann
prettyDeclHead (DataDecl -> [Constraint]
dataDeclContext DataDecl
decl) (DataDecl -> Text
dataDeclName DataDecl
decl) (DataDecl -> [TyVarBinder]
dataDeclParams DataDecl
decl)
      ]
        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann]
forall {ann}. [Doc ann]
ctorPart
        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [DerivingClause] -> [Doc ann]
forall ann. [DerivingClause] -> [Doc ann]
derivingParts (DataDecl -> [DerivingClause]
dataDeclDeriving DataDecl
decl)
    )
  where
    ctorPart :: [Doc ann]
ctorPart =
      case DataDecl -> [DataConDecl]
dataDeclConstructors DataDecl
decl of
        [] -> []
        [DataConDecl]
ctors
          | (DataConDecl -> Bool) -> [DataConDecl] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any DataConDecl -> Bool
isGadtCon [DataConDecl]
ctors -> [Doc ann
"where", Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi ((DataConDecl -> Doc ann) -> [DataConDecl] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map DataConDecl -> Doc ann
forall ann. DataConDecl -> Doc ann
prettyDataCon [DataConDecl]
ctors)))]
          | Bool
otherwise -> [Doc ann
"=", [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
" |" ((DataConDecl -> Doc ann) -> [DataConDecl] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map DataConDecl -> Doc ann
forall ann. DataConDecl -> Doc ann
prettyDataCon [DataConDecl]
ctors))]

-- | Check if a constructor uses GADT syntax
isGadtCon :: DataConDecl -> Bool
isGadtCon :: DataConDecl -> Bool
isGadtCon (GadtCon {}) = Bool
True
isGadtCon DataConDecl
_ = Bool
False

prettyNewtypeDecl :: NewtypeDecl -> Doc ann
prettyNewtypeDecl :: forall ann. NewtypeDecl -> Doc ann
prettyNewtypeDecl NewtypeDecl
decl =
  [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
    ( [ Doc ann
"newtype",
        [Constraint] -> Text -> [TyVarBinder] -> Doc ann
forall ann. [Constraint] -> Text -> [TyVarBinder] -> Doc ann
prettyDeclHead (NewtypeDecl -> [Constraint]
newtypeDeclContext NewtypeDecl
decl) (NewtypeDecl -> Text
newtypeDeclName NewtypeDecl
decl) (NewtypeDecl -> [TyVarBinder]
newtypeDeclParams NewtypeDecl
decl)
      ]
        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann]
forall {ann}. [Doc ann]
ctorPart
        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [DerivingClause] -> [Doc ann]
forall ann. [DerivingClause] -> [Doc ann]
derivingParts (NewtypeDecl -> [DerivingClause]
newtypeDeclDeriving NewtypeDecl
decl)
    )
  where
    ctorPart :: [Doc ann]
ctorPart =
      case NewtypeDecl -> Maybe DataConDecl
newtypeDeclConstructor NewtypeDecl
decl of
        Maybe DataConDecl
Nothing -> []
        Just DataConDecl
ctor
          | DataConDecl -> Bool
isGadtCon DataConDecl
ctor -> [Doc ann
"where", Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (DataConDecl -> Doc ann
forall ann. DataConDecl -> Doc ann
prettyDataCon DataConDecl
ctor)]
          | Bool
otherwise -> [Doc ann
"=", DataConDecl -> Doc ann
forall ann. DataConDecl -> Doc ann
prettyDataCon DataConDecl
ctor]

derivingParts :: [DerivingClause] -> [Doc ann]
derivingParts :: forall ann. [DerivingClause] -> [Doc ann]
derivingParts = (DerivingClause -> [Doc ann]) -> [DerivingClause] -> [Doc ann]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DerivingClause -> [Doc ann]
forall ann. DerivingClause -> [Doc ann]
derivingPart

derivingPart :: DerivingClause -> [Doc ann]
derivingPart :: forall ann. DerivingClause -> [Doc ann]
derivingPart (DerivingClause Maybe DerivingStrategy
strategy [Text]
classes) =
  [Doc ann
"deriving"] [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> Maybe DerivingStrategy -> [Doc ann]
forall {a}. IsString a => Maybe DerivingStrategy -> [a]
strategyPart Maybe DerivingStrategy
strategy [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Text] -> [Doc ann]
forall {a} {ann}. Pretty a => [a] -> [Doc ann]
classesPart [Text]
classes
  where
    strategyPart :: Maybe DerivingStrategy -> [a]
strategyPart Maybe DerivingStrategy
Nothing = []
    strategyPart (Just DerivingStrategy
DerivingStock) = [a
"stock"]
    strategyPart (Just DerivingStrategy
DerivingNewtype) = [a
"newtype"]
    strategyPart (Just DerivingStrategy
DerivingAnyclass) = [a
"anyclass"]

    classesPart :: [a] -> [Doc ann]
classesPart [] = [Doc ann
"()"]
    classesPart [a
single]
      | Just DerivingStrategy
DerivingStock <- Maybe DerivingStrategy
strategy = [Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
single)]
      | Bool
otherwise = [a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
single]
    classesPart [a]
_ = [Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty [Text]
classes)))]

prettyDeclHead :: [Constraint] -> Text -> [TyVarBinder] -> Doc ann
prettyDeclHead :: forall ann. [Constraint] -> Text -> [TyVarBinder] -> Doc ann
prettyDeclHead [Constraint]
constraints Text
name [TyVarBinder]
params =
  [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
    ( [Constraint] -> [Doc ann]
forall ann. [Constraint] -> [Doc ann]
contextPrefix [Constraint]
constraints
        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name]
        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> (TyVarBinder -> Doc ann) -> [TyVarBinder] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBinder -> Doc ann
forall ann. TyVarBinder -> Doc ann
prettyTyVarBinder [TyVarBinder]
params
    )

prettyTyVarBinder :: TyVarBinder -> Doc ann
prettyTyVarBinder :: forall ann. TyVarBinder -> Doc ann
prettyTyVarBinder TyVarBinder
binder =
  case TyVarBinder -> Maybe Type
tyVarBinderKind TyVarBinder
binder of
    Maybe Type
Nothing -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (TyVarBinder -> Text
tyVarBinderName TyVarBinder
binder)
    Just Type
kind -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (TyVarBinder -> Text
tyVarBinderName TyVarBinder
binder) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"::" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type -> Doc ann
forall ann. Type -> Doc ann
prettyType Type
kind)

contextPrefix :: [Constraint] -> [Doc ann]
contextPrefix :: forall ann. [Constraint] -> [Doc ann]
contextPrefix [Constraint]
constraints =
  case [Constraint]
constraints of
    [] -> []
    [Constraint]
_ -> [[Constraint] -> Doc ann
forall ann. [Constraint] -> Doc ann
prettyContext [Constraint]
constraints, Doc ann
"=>"]

prettyDataCon :: DataConDecl -> Doc ann
prettyDataCon :: forall ann. DataConDecl -> Doc ann
prettyDataCon DataConDecl
ctor =
  case DataConDecl
ctor of
    PrefixCon SourceSpan
_ [Text]
forallVars [Constraint]
constraints Text
name [BangType]
fields ->
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Text] -> [Constraint] -> [Doc ann]
forall ann. [Text] -> [Constraint] -> [Doc ann]
dataConQualifierPrefix [Text]
forallVars [Constraint]
constraints [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Text -> Doc ann
forall ann. Text -> Doc ann
prettyConstructorName Text
name] [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> (BangType -> Doc ann) -> [BangType] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map BangType -> Doc ann
forall ann. BangType -> Doc ann
prettyBangType [BangType]
fields)
    InfixCon SourceSpan
_ [Text]
forallVars [Constraint]
constraints BangType
lhs Text
op BangType
rhs ->
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
        ( [Text] -> [Constraint] -> [Doc ann]
forall ann. [Text] -> [Constraint] -> [Doc ann]
dataConQualifierPrefix [Text]
forallVars [Constraint]
constraints
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [BangType -> Doc ann
forall ann. BangType -> Doc ann
prettyBangTypeAtom BangType
lhs, Text -> Doc ann
forall ann. Text -> Doc ann
prettyInfixOp Text
op, BangType -> Doc ann
forall ann. BangType -> Doc ann
prettyBangTypeAtom BangType
rhs]
        )
    RecordCon SourceSpan
_ [Text]
forallVars [Constraint]
constraints Text
name [FieldDecl]
fields ->
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Text] -> [Constraint] -> [Doc ann]
forall ann. [Text] -> [Constraint] -> [Doc ann]
dataConQualifierPrefix [Text]
forallVars [Constraint]
constraints [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Text -> Doc ann
forall ann. Text -> Doc ann
prettyConstructorName Text
name])
        Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces
          ( [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
              ( Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate
                  Doc ann
forall ann. Doc ann
comma
                  [ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
                      [ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (FieldDecl -> [Text]
fieldNames FieldDecl
fld))),
                        Doc ann
"::",
                        BangType -> Doc ann
forall ann. BangType -> Doc ann
prettyRecordFieldBangType (FieldDecl -> BangType
fieldType FieldDecl
fld)
                      ]
                  | FieldDecl
fld <- [FieldDecl]
fields
                  ]
              )
          )
    GadtCon SourceSpan
_ [TyVarBinder]
forallBinders [Constraint]
constraints [Text]
names GadtBody
body ->
      [TyVarBinder] -> [Constraint] -> [Text] -> GadtBody -> Doc ann
forall ann.
[TyVarBinder] -> [Constraint] -> [Text] -> GadtBody -> Doc ann
prettyGadtCon [TyVarBinder]
forallBinders [Constraint]
constraints [Text]
names GadtBody
body

-- | Pretty print a GADT constructor in GADT syntax: @Con :: forall a. Ctx => Type@
prettyGadtCon :: [TyVarBinder] -> [Constraint] -> [Text] -> GadtBody -> Doc ann
prettyGadtCon :: forall ann.
[TyVarBinder] -> [Constraint] -> [Text] -> GadtBody -> Doc ann
prettyGadtCon [TyVarBinder]
forallBinders [Constraint]
constraints [Text]
names GadtBody
body =
  [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
    ( [[Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall ann. Text -> Doc ann
prettyConstructorName [Text]
names)), Doc ann
"::"]
        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann]
forall {ann}. [Doc ann]
forallPart
        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann]
forall {ann}. [Doc ann]
contextPart
        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [GadtBody -> Doc ann
forall ann. GadtBody -> Doc ann
prettyGadtBody GadtBody
body]
    )
  where
    forallPart :: [Doc ann]
forallPart
      | [TyVarBinder] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVarBinder]
forallBinders = []
      | Bool
otherwise = [Doc ann
"forall", [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ((TyVarBinder -> Doc ann) -> [TyVarBinder] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBinder -> Doc ann
forall ann. TyVarBinder -> Doc ann
prettyTyVarBinder [TyVarBinder]
forallBinders) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"."]
    contextPart :: [Doc ann]
contextPart
      | [Constraint] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Constraint]
constraints = []
      | Bool
otherwise = [[Constraint] -> Doc ann
forall ann. [Constraint] -> Doc ann
prettyContext [Constraint]
constraints, Doc ann
"=>"]

-- | Pretty print the body of a GADT constructor
prettyGadtBody :: GadtBody -> Doc ann
prettyGadtBody :: forall ann. GadtBody -> Doc ann
prettyGadtBody GadtBody
body =
  case GadtBody
body of
    GadtPrefixBody [BangType]
args Type
resultTy ->
      case [BangType]
args of
        [] -> Type -> Doc ann
forall ann. Type -> Doc ann
prettyType Type
resultTy
        [BangType]
_ -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
" ->" ((BangType -> Doc ann) -> [BangType] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map BangType -> Doc ann
forall ann. BangType -> Doc ann
prettyBangType [BangType]
args [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [Type -> Doc ann
forall ann. Type -> Doc ann
prettyType Type
resultTy]))
    GadtRecordBody [FieldDecl]
fields Type
resultTy ->
      Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([FieldDecl] -> Doc ann
forall ann. [FieldDecl] -> Doc ann
prettyRecordFields [FieldDecl]
fields) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type -> Doc ann
forall ann. Type -> Doc ann
prettyType Type
resultTy

-- | Pretty print record fields for GADT body
prettyRecordFields :: [FieldDecl] -> Doc ann
prettyRecordFields :: forall ann. [FieldDecl] -> Doc ann
prettyRecordFields [FieldDecl]
fields =
  [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
    ( Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate
        Doc ann
forall ann. Doc ann
comma
        [ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
            [ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (FieldDecl -> [Text]
fieldNames FieldDecl
fld))),
              Doc ann
"::",
              BangType -> Doc ann
forall ann. BangType -> Doc ann
prettyRecordFieldBangType (FieldDecl -> BangType
fieldType FieldDecl
fld)
            ]
        | FieldDecl
fld <- [FieldDecl]
fields
        ]
    )

dataConQualifierPrefix :: [Text] -> [Constraint] -> [Doc ann]
dataConQualifierPrefix :: forall ann. [Text] -> [Constraint] -> [Doc ann]
dataConQualifierPrefix [Text]
forallVars [Constraint]
constraints = [Text] -> [Doc ann]
forall {a} {ann}. Pretty a => [a] -> [Doc ann]
forallPrefix [Text]
forallVars [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Constraint] -> [Doc ann]
forall ann. [Constraint] -> [Doc ann]
contextPrefix [Constraint]
constraints
  where
    forallPrefix :: [a] -> [Doc ann]
forallPrefix [] = []
    forallPrefix [a]
binders = [Doc ann
"forall", [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ((a -> Doc ann) -> [a] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [a]
binders) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"."]

-- | Pretty print a BangType in GADT prefix body context.
-- For strict types (!Type), we use atomic type rendering to ensure the type is atomic
-- (e.g., !Int or !(Term a), not !Term a which would be parsed as (!Term) a).
-- For non-strict types, we use function-LHS context rendering since only function types,
-- foralls, and contexts need parentheses before -> in GADT syntax.
prettyBangType :: BangType -> Doc ann
prettyBangType :: forall ann. BangType -> Doc ann
prettyBangType BangType
bt
  | BangType -> Bool
bangStrict BangType
bt = Doc ann
"!" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TypeCtx -> Type -> Doc ann
forall ann. TypeCtx -> Type -> Doc ann
prettyTypeIn TypeCtx
CtxTypeAtom (BangType -> Type
bangType BangType
bt)
  | Bool
otherwise = TypeCtx -> Type -> Doc ann
forall ann. TypeCtx -> Type -> Doc ann
prettyTypeIn TypeCtx
CtxTypeFunArg (BangType -> Type
bangType BangType
bt)

prettyRecordFieldBangType :: BangType -> Doc ann
prettyRecordFieldBangType :: forall ann. BangType -> Doc ann
prettyRecordFieldBangType BangType
bt
  | BangType -> Bool
bangStrict BangType
bt = Doc ann
"!" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Type -> Doc ann
forall ann. Type -> Doc ann
prettyType (BangType -> Type
bangType BangType
bt)
  | Bool
otherwise = Type -> Doc ann
forall ann. Type -> Doc ann
prettyType (BangType -> Type
bangType BangType
bt)

-- | Pretty print a BangType as an atom (e.g., for infix data constructors).
-- Wraps the entire bang type in parens if the underlying type needs it.
prettyBangTypeAtom :: BangType -> Doc ann
prettyBangTypeAtom :: forall ann. BangType -> Doc ann
prettyBangTypeAtom BangType
bt =
  Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize (TypeCtx -> Type -> Bool
needsTypeParens TypeCtx
CtxTypeFunArg (BangType -> Type
bangType BangType
bt)) (BangType -> Doc ann
forall ann. BangType -> Doc ann
prettyBangType BangType
bt)

prettyClassDecl :: ClassDecl -> Doc ann
prettyClassDecl :: forall ann. ClassDecl -> Doc ann
prettyClassDecl ClassDecl
decl =
  let headDoc :: Doc ann
headDoc =
        [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
          ( [Doc ann
"class"]
              [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> Maybe [Constraint] -> [Doc ann]
forall ann. Maybe [Constraint] -> [Doc ann]
maybeContextPrefix (ClassDecl -> Maybe [Constraint]
classDeclContext ClassDecl
decl)
              [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (ClassDecl -> Text
classDeclName ClassDecl
decl)]
              [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> (TyVarBinder -> Doc ann) -> [TyVarBinder] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBinder -> Doc ann
forall ann. TyVarBinder -> Doc ann
prettyTyVarBinder (ClassDecl -> [TyVarBinder]
classDeclParams ClassDecl
decl)
          )
   in case ClassDecl -> [ClassDeclItem]
classDeclItems ClassDecl
decl of
        [] -> Doc ann
forall ann. Doc ann
headDoc
        [ClassDeclItem]
items -> Doc ann
forall ann. Doc ann
headDoc Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"where" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi ((ClassDeclItem -> Doc ann) -> [ClassDeclItem] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ClassDeclItem -> Doc ann
forall ann. ClassDeclItem -> Doc ann
prettyClassItem [ClassDeclItem]
items)))

maybeContextPrefix :: Maybe [Constraint] -> [Doc ann]
maybeContextPrefix :: forall ann. Maybe [Constraint] -> [Doc ann]
maybeContextPrefix Maybe [Constraint]
maybeConstraints =
  case Maybe [Constraint]
maybeConstraints of
    Maybe [Constraint]
Nothing -> []
    Just [Constraint]
constraints -> [[Constraint] -> Doc ann
forall ann. [Constraint] -> Doc ann
prettyContext [Constraint]
constraints, Doc ann
"=>"]

prettyClassItem :: ClassDeclItem -> Doc ann
prettyClassItem :: forall ann. ClassDeclItem -> Doc ann
prettyClassItem ClassDeclItem
item =
  case ClassDeclItem
item of
    ClassItemTypeSig SourceSpan
_ [Text]
names Type
ty -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep [[Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall ann. Text -> Doc ann
prettyBinderName [Text]
names)), Doc ann
"::", Type -> Doc ann
forall ann. Type -> Doc ann
prettyType Type
ty]
    ClassItemFixity SourceSpan
_ FixityAssoc
assoc Maybe Int
prec [Text]
ops ->
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
        ( [FixityAssoc -> Doc ann
forall ann. FixityAssoc -> Doc ann
prettyFixityAssoc FixityAssoc
assoc]
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> (Int -> [Doc ann]) -> Maybe Int -> [Doc ann]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc ann -> [Doc ann]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc ann -> [Doc ann]) -> (Int -> Doc ann) -> Int -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> (Int -> String) -> Int -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) Maybe Int
prec
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> (Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall ann. Text -> Doc ann
prettyInfixOp [Text]
ops
        )
    ClassItemDefault SourceSpan
_ ValueDecl
valueDecl -> ValueDecl -> Doc ann
forall ann. ValueDecl -> Doc ann
prettyValueDeclSingleLine ValueDecl
valueDecl

prettyInstanceDecl :: InstanceDecl -> Doc ann
prettyInstanceDecl :: forall ann. InstanceDecl -> Doc ann
prettyInstanceDecl InstanceDecl
decl =
  let headDoc :: Doc ann
headDoc =
        [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
          ( [Doc ann
"instance"]
              [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Constraint] -> [Doc ann]
forall ann. [Constraint] -> [Doc ann]
contextPrefix (InstanceDecl -> [Constraint]
instanceDeclContext InstanceDecl
decl)
              [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (InstanceDecl -> Text
instanceDeclClassName InstanceDecl
decl)]
              [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> (Type -> Doc ann) -> [Type] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (TypeCtx -> Type -> Doc ann
forall ann. TypeCtx -> Type -> Doc ann
prettyTypeIn TypeCtx
CtxTypeAtom) (InstanceDecl -> [Type]
instanceDeclTypes InstanceDecl
decl)
          )
   in case InstanceDecl -> [InstanceDeclItem]
instanceDeclItems InstanceDecl
decl of
        [] -> Doc ann
forall ann. Doc ann
headDoc
        [InstanceDeclItem]
items -> Doc ann
forall ann. Doc ann
headDoc Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"where" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi ((InstanceDeclItem -> Doc ann) -> [InstanceDeclItem] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map InstanceDeclItem -> Doc ann
forall ann. InstanceDeclItem -> Doc ann
prettyInstanceItem [InstanceDeclItem]
items)))

prettyStandaloneDeriving :: StandaloneDerivingDecl -> Doc ann
prettyStandaloneDeriving :: forall ann. StandaloneDerivingDecl -> Doc ann
prettyStandaloneDeriving StandaloneDerivingDecl
decl =
  [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
    ( [Doc ann
"deriving"]
        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann]
-> (DerivingStrategy -> [Doc ann])
-> Maybe DerivingStrategy
-> [Doc ann]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\DerivingStrategy
s -> [DerivingStrategy -> Doc ann
forall ann. DerivingStrategy -> Doc ann
prettyDerivingStrategy DerivingStrategy
s]) (StandaloneDerivingDecl -> Maybe DerivingStrategy
standaloneDerivingStrategy StandaloneDerivingDecl
decl)
        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann
"instance"]
        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Constraint] -> [Doc ann]
forall ann. [Constraint] -> [Doc ann]
contextPrefix (StandaloneDerivingDecl -> [Constraint]
standaloneDerivingContext StandaloneDerivingDecl
decl)
        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (StandaloneDerivingDecl -> Text
standaloneDerivingClassName StandaloneDerivingDecl
decl)]
        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> (Type -> Doc ann) -> [Type] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (TypeCtx -> Type -> Doc ann
forall ann. TypeCtx -> Type -> Doc ann
prettyTypeIn TypeCtx
CtxTypeAtom) (StandaloneDerivingDecl -> [Type]
standaloneDerivingTypes StandaloneDerivingDecl
decl)
    )

prettyDerivingStrategy :: DerivingStrategy -> Doc ann
prettyDerivingStrategy :: forall ann. DerivingStrategy -> Doc ann
prettyDerivingStrategy DerivingStrategy
strategy =
  case DerivingStrategy
strategy of
    DerivingStrategy
DerivingStock -> Doc ann
"stock"
    DerivingStrategy
DerivingNewtype -> Doc ann
"newtype"
    DerivingStrategy
DerivingAnyclass -> Doc ann
"anyclass"

prettyInstanceItem :: InstanceDeclItem -> Doc ann
prettyInstanceItem :: forall ann. InstanceDeclItem -> Doc ann
prettyInstanceItem InstanceDeclItem
item =
  case InstanceDeclItem
item of
    InstanceItemBind SourceSpan
_ ValueDecl
valueDecl -> ValueDecl -> Doc ann
forall ann. ValueDecl -> Doc ann
prettyValueDeclSingleLine ValueDecl
valueDecl
    InstanceItemTypeSig SourceSpan
_ [Text]
names Type
ty -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep [[Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall ann. Text -> Doc ann
prettyBinderName [Text]
names)), Doc ann
"::", Type -> Doc ann
forall ann. Type -> Doc ann
prettyType Type
ty]
    InstanceItemFixity SourceSpan
_ FixityAssoc
assoc Maybe Int
prec [Text]
ops ->
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
        ( [FixityAssoc -> Doc ann
forall ann. FixityAssoc -> Doc ann
prettyFixityAssoc FixityAssoc
assoc]
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> (Int -> [Doc ann]) -> Maybe Int -> [Doc ann]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Doc ann -> [Doc ann]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc ann -> [Doc ann]) -> (Int -> Doc ann) -> Int -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> (Int -> String) -> Int -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) Maybe Int
prec
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> (Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall ann. Text -> Doc ann
prettyInfixOp [Text]
ops
        )

prettyFixityAssoc :: FixityAssoc -> Doc ann
prettyFixityAssoc :: forall ann. FixityAssoc -> Doc ann
prettyFixityAssoc FixityAssoc
assoc =
  case FixityAssoc
assoc of
    FixityAssoc
Infix -> Doc ann
"infix"
    FixityAssoc
InfixL -> Doc ann
"infixl"
    FixityAssoc
InfixR -> Doc ann
"infixr"

prettyForeignDecl :: ForeignDecl -> Doc ann
prettyForeignDecl :: forall ann. ForeignDecl -> Doc ann
prettyForeignDecl ForeignDecl
decl =
  [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann)
-> ([Maybe (Doc ann)] -> [Doc ann]) -> [Maybe (Doc ann)] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Doc ann)] -> [Doc ann]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Doc ann)] -> Doc ann) -> [Maybe (Doc ann)] -> Doc ann
forall a b. (a -> b) -> a -> b
$
    [ Doc ann -> Maybe (Doc ann)
forall a. a -> Maybe a
Just Doc ann
"foreign",
      Doc ann -> Maybe (Doc ann)
forall a. a -> Maybe a
Just (ForeignDirection -> Doc ann
forall ann. ForeignDirection -> Doc ann
prettyDirection (ForeignDecl -> ForeignDirection
foreignDirection ForeignDecl
decl)),
      Doc ann -> Maybe (Doc ann)
forall a. a -> Maybe a
Just (CallConv -> Doc ann
forall ann. CallConv -> Doc ann
prettyCallConv (ForeignDecl -> CallConv
foreignCallConv ForeignDecl
decl)),
      ForeignSafety -> Doc ann
forall ann. ForeignSafety -> Doc ann
prettySafety (ForeignSafety -> Doc ann)
-> Maybe ForeignSafety -> Maybe (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignDecl -> Maybe ForeignSafety
foreignSafety ForeignDecl
decl,
      ForeignEntitySpec -> Maybe (Doc ann)
forall ann. ForeignEntitySpec -> Maybe (Doc ann)
prettyForeignEntity (ForeignDecl -> ForeignEntitySpec
foreignEntity ForeignDecl
decl),
      Doc ann -> Maybe (Doc ann)
forall a. a -> Maybe a
Just (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (ForeignDecl -> Text
foreignName ForeignDecl
decl)),
      Doc ann -> Maybe (Doc ann)
forall a. a -> Maybe a
Just Doc ann
"::",
      Doc ann -> Maybe (Doc ann)
forall a. a -> Maybe a
Just (Type -> Doc ann
forall ann. Type -> Doc ann
prettyType (ForeignDecl -> Type
foreignType ForeignDecl
decl))
    ]

prettyDirection :: ForeignDirection -> Doc ann
prettyDirection :: forall ann. ForeignDirection -> Doc ann
prettyDirection ForeignDirection
direction =
  case ForeignDirection
direction of
    ForeignDirection
ForeignImport -> Doc ann
"import"
    ForeignDirection
ForeignExport -> Doc ann
"export"

prettyCallConv :: CallConv -> Doc ann
prettyCallConv :: forall ann. CallConv -> Doc ann
prettyCallConv CallConv
cc =
  case CallConv
cc of
    CallConv
CCall -> Doc ann
"ccall"
    CallConv
StdCall -> Doc ann
"stdcall"

prettySafety :: ForeignSafety -> Doc ann
prettySafety :: forall ann. ForeignSafety -> Doc ann
prettySafety ForeignSafety
safety =
  case ForeignSafety
safety of
    ForeignSafety
Safe -> Doc ann
"safe"
    ForeignSafety
Unsafe -> Doc ann
"unsafe"

prettyForeignEntity :: ForeignEntitySpec -> Maybe (Doc ann)
prettyForeignEntity :: forall ann. ForeignEntitySpec -> Maybe (Doc ann)
prettyForeignEntity ForeignEntitySpec
spec =
  case ForeignEntitySpec
spec of
    ForeignEntitySpec
ForeignEntityOmitted -> Maybe (Doc ann)
forall a. Maybe a
Nothing
    ForeignEntitySpec
ForeignEntityDynamic -> Doc ann -> Maybe (Doc ann)
forall a. a -> Maybe a
Just (Text -> Doc ann
forall ann. Text -> Doc ann
quoted Text
"dynamic")
    ForeignEntitySpec
ForeignEntityWrapper -> Doc ann -> Maybe (Doc ann)
forall a. a -> Maybe a
Just (Text -> Doc ann
forall ann. Text -> Doc ann
quoted Text
"wrapper")
    ForeignEntityStatic Maybe Text
Nothing -> Doc ann -> Maybe (Doc ann)
forall a. a -> Maybe a
Just (Text -> Doc ann
forall ann. Text -> Doc ann
quoted Text
"static")
    ForeignEntityStatic (Just Text
name) -> Doc ann -> Maybe (Doc ann)
forall a. a -> Maybe a
Just (Text -> Doc ann
forall ann. Text -> Doc ann
quoted (Text
"static " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name))
    ForeignEntityAddress Maybe Text
Nothing -> Doc ann -> Maybe (Doc ann)
forall a. a -> Maybe a
Just (Text -> Doc ann
forall ann. Text -> Doc ann
quoted Text
"&")
    ForeignEntityAddress (Just Text
name) -> Doc ann -> Maybe (Doc ann)
forall a. a -> Maybe a
Just (Text -> Doc ann
forall ann. Text -> Doc ann
quoted (Text
"&" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name))
    ForeignEntityNamed Text
name -> Doc ann -> Maybe (Doc ann)
forall a. a -> Maybe a
Just (Text -> Doc ann
forall ann. Text -> Doc ann
quoted Text
name)

prettyInfixOp :: Text -> Doc ann
prettyInfixOp :: forall ann. Text -> Doc ann
prettyInfixOp Text
op
  | Text -> Bool
isOperatorToken Text
op = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
op
  | Bool
otherwise = Doc ann
"`" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
op Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"`"

prettyFunctionBinder :: Text -> Doc ann
prettyFunctionBinder :: forall ann. Text -> Doc ann
prettyFunctionBinder Text
name
  | Text -> Bool
isOperatorToken Text
name = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name)
  | Bool
otherwise = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name

prettyBinderName :: Text -> Doc ann
prettyBinderName :: forall ann. Text -> Doc ann
prettyBinderName = Text -> Doc ann
forall ann. Text -> Doc ann
prettyFunctionBinder

prettyConstructorName :: Text -> Doc ann
prettyConstructorName :: forall ann. Text -> Doc ann
prettyConstructorName Text
name
  | Text -> Bool
isOperatorToken Text
name = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name)
  | Bool
otherwise = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name

-- | Print an expression in a context-sensitive slot.
-- Nested infix expressions need context-sensitive parenthesization, not just
-- operator precedence. We model these slots explicitly.
data ExprCtx
  = CtxInfixRhs Bool
  | CtxInfixLhs
  | CtxWhereBody
  | CtxAppFun
  | CtxTypeSigBody
  | CtxGuarded

prettyExprIn :: ExprCtx -> Expr -> Doc ann
prettyExprIn :: forall ann. ExprCtx -> Expr -> Doc ann
prettyExprIn ExprCtx
ctx Expr
expr =
  Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize (ExprCtx -> Expr -> Bool
needsExprParens ExprCtx
ctx Expr
expr) (Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec (ExprCtx -> Expr -> Int
exprCtxPrec ExprCtx
ctx Expr
expr) Expr
expr)

exprCtxPrec :: ExprCtx -> Expr -> Int
exprCtxPrec :: ExprCtx -> Expr -> Int
exprCtxPrec ExprCtx
ctx Expr
expr =
  case ExprCtx
ctx of
    CtxInfixRhs Bool
_
      | Expr -> Bool
isGreedyExpr Expr
expr -> Int
0
      | Bool
otherwise -> Int
1
    ExprCtx
CtxInfixLhs -> Int
1
    ExprCtx
CtxWhereBody -> Int
0
    ExprCtx
CtxAppFun -> Int
2
    ExprCtx
CtxTypeSigBody -> Int
1
    ExprCtx
CtxGuarded -> Int
0

needsExprParens :: ExprCtx -> Expr -> Bool
needsExprParens :: ExprCtx -> Expr -> Bool
needsExprParens ExprCtx
ctx Expr
expr =
  case ExprCtx
ctx of
    CtxInfixRhs Bool
protectOpenEnded ->
      case Expr
expr of
        EInfix {} -> Bool
True
        ETypeSig {} -> Bool
True
        ENegate {} -> Bool
True
        EWhereDecls {} -> Bool
True
        Expr
_ | Bool
protectOpenEnded Bool -> Bool -> Bool
&& Expr -> Bool
isOpenEnded Expr
expr -> Bool
True
        Expr
_ -> Bool
False
    ExprCtx
CtxInfixLhs ->
      case Expr
expr of
        ETypeSig {} -> Bool
True
        ENegate {} -> Bool
True
        Expr
_ -> Bool
False
    ExprCtx
CtxWhereBody ->
      case Expr
expr of
        ENegate {} -> Bool
True
        Expr
_ -> Expr -> Bool
isOpenEnded Expr
expr
    ExprCtx
CtxAppFun ->
      case Expr
expr of
        ENegate {} -> Bool
True
        Expr
_ -> Bool
False
    ExprCtx
CtxTypeSigBody ->
      case Expr
expr of
        ENegate {} -> Bool
True
        ETypeSig {} -> Bool
True
        ELambdaPats {} -> Bool
True
        Expr
_ -> Bool
False
    ExprCtx
CtxGuarded -> Expr -> Bool
isGreedyExpr Expr
expr

-- | Check if an expression is "greedy" - i.e., it could consume trailing syntax.
-- These expressions may need special handling in certain contexts.
isGreedyExpr :: Expr -> Bool
isGreedyExpr :: Expr -> Bool
isGreedyExpr = \case
  ECase {} -> Bool
True
  EIf {} -> Bool
True
  ELambdaPats {} -> Bool
True
  ELambdaCase {} -> Bool
True
  ELetDecls {} -> Bool
True
  EWhereDecls {} -> Bool
True
  EDo {} -> Bool
True
  Expr
_ -> Bool
False

-- | Print an expression in a "guarded" context where greedy expressions
-- need parentheses to prevent them from consuming trailing syntax.
prettyExprGuarded :: Expr -> Doc ann
prettyExprGuarded :: forall ann. Expr -> Doc ann
prettyExprGuarded = ExprCtx -> Expr -> Doc ann
forall ann. ExprCtx -> Expr -> Doc ann
prettyExprIn ExprCtx
CtxGuarded

-- | Check if an expression is "open-ended" - its rightmost component can
-- capture a trailing where clause. This includes:
-- - Directly open-ended expressions (if, lambda, let)
-- - Infix expressions whose RHS is open-ended (recursively)
-- Brace-terminated expressions (do, case, \case) are NOT open-ended because
-- their explicit braces delimit them.
isOpenEnded :: Expr -> Bool
isOpenEnded :: Expr -> Bool
isOpenEnded = \case
  EIf {} -> Bool
True
  ELambdaPats {} -> Bool
True
  ELetDecls {} -> Bool
True
  EWhereDecls {} -> Bool
True
  EInfix SourceSpan
_ Expr
_ Text
_ Expr
rhs -> Expr -> Bool
isOpenEnded Expr
rhs
  Expr
_ -> Bool
False

-- | Print the body of a where expression.
prettyWhereBody :: Expr -> Doc ann
prettyWhereBody :: forall ann. Expr -> Doc ann
prettyWhereBody = ExprCtx -> Expr -> Doc ann
forall ann. ExprCtx -> Expr -> Doc ann
prettyExprIn ExprCtx
CtxWhereBody

-- | Print an expression used as the function in an application.
prettyExprApp :: Expr -> Doc ann
prettyExprApp :: forall ann. Expr -> Doc ann
prettyExprApp = ExprCtx -> Expr -> Doc ann
forall ann. ExprCtx -> Expr -> Doc ann
prettyExprIn ExprCtx
CtxAppFun

-- | Print a negation expression.
prettyNegate :: Expr -> Doc ann
prettyNegate :: forall ann. Expr -> Doc ann
prettyNegate Expr
inner = Doc ann
"-" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
3 Expr
inner

-- | Print the body of a type signature expression.
prettyTypeSigBody :: Expr -> Doc ann
prettyTypeSigBody :: forall ann. Expr -> Doc ann
prettyTypeSigBody = ExprCtx -> Expr -> Doc ann
forall ann. ExprCtx -> Expr -> Doc ann
prettyExprIn ExprCtx
CtxTypeSigBody

prettyExprPrec :: Int -> Expr -> Doc ann
prettyExprPrec :: forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
prec Expr
expr =
  case Expr
expr of
    EApp SourceSpan
_ Expr
fn Expr
arg ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2) (Expr -> Doc ann
forall ann. Expr -> Doc ann
prettyExprApp Expr
fn Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
3 Expr
arg)
    ETypeApp SourceSpan
_ Expr
fn Type
ty ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2) (Expr -> Doc ann
forall ann. Expr -> Doc ann
prettyExprApp Expr
fn Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"@" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TypeCtx -> Type -> Doc ann
forall ann. TypeCtx -> Type -> Doc ann
prettyTypeIn TypeCtx
CtxTypeAtom Type
ty)
    EVar SourceSpan
_ Text
name
      | Text -> Bool
isOperatorToken Text
name -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name)
      | Bool
otherwise -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name
    EInt SourceSpan
_ Integer
_ Text
repr -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
repr
    EIntBase SourceSpan
_ Integer
_ Text
repr -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
repr
    EFloat SourceSpan
_ Double
_ Text
repr -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
repr
    EChar SourceSpan
_ Char
_ Text
repr -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
repr
    EString SourceSpan
_ Text
_ Text
repr -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
repr
    EQuasiQuote SourceSpan
_ Text
quoter Text
body -> Text -> Text -> Doc ann
forall ann. Text -> Text -> Doc ann
prettyQuasiQuote Text
quoter Text
body
    EIf SourceSpan
_ Expr
cond Expr
yes Expr
no ->
      -- The 'then' keyword delimits the condition, and 'else' delimits the then-branch,
      -- so greedy expressions in those positions don't need parentheses.
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize
        (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
        (Doc ann
"if" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
cond Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"then" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
yes Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"else" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
no)
    ELambdaPats SourceSpan
_ [Pattern]
pats Expr
body ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Doc ann
"\\" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ((Pattern -> Doc ann) -> [Pattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern [Pattern]
pats) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
body)
    ELambdaCase SourceSpan
_ [CaseAlt]
alts ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize
        (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
        (Doc ann
"\\" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"case" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"{" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi ((CaseAlt -> Doc ann) -> [CaseAlt] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map CaseAlt -> Doc ann
forall ann. CaseAlt -> Doc ann
prettyCaseAlt [CaseAlt]
alts)) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"}")
    EInfix SourceSpan
_ Expr
lhs Text
op Expr
rhs ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize
        (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1)
        (ExprCtx -> Expr -> Doc ann
forall ann. ExprCtx -> Expr -> Doc ann
prettyExprIn ExprCtx
CtxInfixLhs Expr
lhs Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
prettyInfixOp Text
op Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ExprCtx -> Expr -> Doc ann
forall ann. ExprCtx -> Expr -> Doc ann
prettyExprIn (Bool -> ExprCtx
CtxInfixRhs (Int
prec Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1)) Expr
rhs)
    ENegate SourceSpan
_ Expr
inner -> Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2) (Expr -> Doc ann
forall ann. Expr -> Doc ann
prettyNegate Expr
inner)
    ESectionL SourceSpan
_ Expr
lhs Text
op -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
3 Expr
lhs Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
prettyInfixOp Text
op)
    ESectionR SourceSpan
_ Text
op Expr
rhs -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Text -> Doc ann
forall ann. Text -> Doc ann
prettyInfixOp Text
op Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
rhs)
    ELetDecls SourceSpan
_ [Decl]
decls Expr
body ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize
        (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
        ( Doc ann
"let"
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Decl] -> Doc ann
forall ann. [Decl] -> Doc ann
prettyInlineDecls [Decl]
decls)
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"in"
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
body
        )
    ECase SourceSpan
_ Expr
scrutinee [CaseAlt]
alts ->
      -- The 'of' keyword delimits the scrutinee, so greedy expressions don't need parens
      -- Use "{ " instead of braces to avoid {- being lexed as block comment start
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize
        (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
        ( Doc ann
"case"
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
scrutinee
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"of"
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"{"
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi ((CaseAlt -> Doc ann) -> [CaseAlt] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map CaseAlt -> Doc ann
forall ann. CaseAlt -> Doc ann
prettyCaseAlt [CaseAlt]
alts))
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"}"
        )
    EDo SourceSpan
_ [DoStmt]
stmts ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize
        (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
        (Doc ann
"do" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"{" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi ((DoStmt -> Doc ann) -> [DoStmt] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map DoStmt -> Doc ann
forall ann. DoStmt -> Doc ann
prettyDoStmt [DoStmt]
stmts)) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"}")
    EListComp SourceSpan
_ Expr
body [CompStmt]
quals ->
      -- Brace-terminated expressions in the body don't capture the |
      Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets
        ( Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
body
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"|"
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((CompStmt -> Doc ann) -> [CompStmt] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map CompStmt -> Doc ann
forall ann. CompStmt -> Doc ann
prettyCompStmt [CompStmt]
quals))
        )
    EListCompParallel SourceSpan
_ Expr
body [[CompStmt]]
qualifierGroups ->
      -- Brace-terminated expressions in the body don't capture the |
      Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets
        ( Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
body
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"|"
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
              ( Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate
                  Doc ann
"|"
                  (([CompStmt] -> Doc ann) -> [[CompStmt]] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann)
-> ([CompStmt] -> [Doc ann]) -> [CompStmt] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann])
-> ([CompStmt] -> [Doc ann]) -> [CompStmt] -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompStmt -> Doc ann) -> [CompStmt] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map CompStmt -> Doc ann
forall ann. CompStmt -> Doc ann
prettyCompStmt) [[CompStmt]]
qualifierGroups)
              )
        )
    EArithSeq SourceSpan
_ ArithSeq
seqInfo -> ArithSeq -> Doc ann
forall ann. ArithSeq -> Doc ann
prettyArithSeq ArithSeq
seqInfo
    ERecordCon SourceSpan
_ Text
name [(Text, Expr)]
fields ->
      Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma (((Text, Expr) -> Doc ann) -> [(Text, Expr)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Expr) -> Doc ann
forall ann. (Text, Expr) -> Doc ann
prettyBinding [(Text, Expr)]
fields)))
    ERecordUpd SourceSpan
_ Expr
base [(Text, Expr)]
fields ->
      Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
3 Expr
base Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma (((Text, Expr) -> Doc ann) -> [(Text, Expr)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Expr) -> Doc ann
forall ann. (Text, Expr) -> Doc ann
prettyBinding [(Text, Expr)]
fields)))
    ETypeSig SourceSpan
_ Expr
inner Type
ty -> Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Expr -> Doc ann
forall ann. Expr -> Doc ann
prettyTypeSigBody Expr
inner Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"::" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type -> Doc ann
forall ann. Type -> Doc ann
prettyType Type
ty)
    EParen SourceSpan
_ Expr
inner ->
      case Expr
inner of
        ESectionL {} -> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
inner
        ESectionR {} -> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
inner
        Expr
_ -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
inner)
    EWhereDecls SourceSpan
_ Expr
body [Decl]
decls ->
      Bool -> Doc ann -> Doc ann
forall ann. Bool -> Doc ann -> Doc ann
parenthesize
        (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
        (Expr -> Doc ann
forall ann. Expr -> Doc ann
prettyWhereBody Expr
body Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"where" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Decl] -> Doc ann
forall ann. [Decl] -> Doc ann
prettyInlineDecls [Decl]
decls))
    EList SourceSpan
_ [Expr]
values -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Expr -> Doc ann) -> [Expr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0) [Expr]
values)))
    ETuple SourceSpan
_ [Expr]
values -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Expr -> Doc ann) -> [Expr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0) [Expr]
values)))
    ETupleSection SourceSpan
_ [Maybe Expr]
values ->
      Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens
        ( [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
            ( Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate
                Doc ann
forall ann. Doc ann
comma
                ( (Maybe Expr -> Doc ann) -> [Maybe Expr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map
                    ( \case
                        Just Expr
val -> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
val
                        Maybe Expr
Nothing -> Doc ann
forall a. Monoid a => a
mempty
                    )
                    [Maybe Expr]
values
                )
            )
        )
    ETupleCon SourceSpan
_ Int
arity -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (Int -> Text -> Text
T.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Text
","))

-- | Pretty print a record field binding.
-- Supports NamedFieldPuns: if value is a variable with the same name as the field,
-- print just the field name (punned form).
-- Record fields are comma-separated, so greedy expressions don't need parens.
prettyBinding :: (Text, Expr) -> Doc ann
prettyBinding :: forall ann. (Text, Expr) -> Doc ann
prettyBinding (Text
name, Expr
value) =
  case Expr
value of
    EVar SourceSpan
_ Text
varName | Text
varName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name -- NamedFieldPuns: punned form
    Expr
_ -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
value

-- | Pretty print a case alternative.
-- Since case alternatives are separated by semicolons (in explicit brace syntax),
-- greedy expressions in the body don't need parentheses.
prettyCaseAlt :: CaseAlt -> Doc ann
prettyCaseAlt :: forall ann. CaseAlt -> Doc ann
prettyCaseAlt (CaseAlt SourceSpan
_ Pattern
pat Rhs
rhs) =
  case Rhs
rhs of
    UnguardedRhs SourceSpan
_ Expr
expr -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
expr
    GuardedRhss SourceSpan
_ [GuardedRhs]
grhss ->
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
        [ Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat,
          [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
            [ Doc ann
"|"
                Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((GuardQualifier -> Doc ann) -> [GuardQualifier] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map GuardQualifier -> Doc ann
forall ann. GuardQualifier -> Doc ann
prettyGuardQualifier (GuardedRhs -> [GuardQualifier]
guardedRhsGuards GuardedRhs
grhs)))
                Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->"
                Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 (GuardedRhs -> Expr
guardedRhsBody GuardedRhs
grhs)
            | GuardedRhs
grhs <- [GuardedRhs]
grhss
            ]
        ]

prettyGuardQualifier :: GuardQualifier -> Doc ann
prettyGuardQualifier :: forall ann. GuardQualifier -> Doc ann
prettyGuardQualifier GuardQualifier
qualifier =
  case GuardQualifier
qualifier of
    GuardExpr SourceSpan
_ Expr
expr -> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
expr
    GuardPat SourceSpan
_ Pattern
pat Expr
expr -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
expr
    GuardLet SourceSpan
_ [Decl]
decls -> Doc ann
"let" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Decl] -> Doc ann
forall ann. [Decl] -> Doc ann
prettyInlineDecls [Decl]
decls)

-- | Pretty print a do statement.
-- Since do blocks are always rendered with explicit braces and semicolons,
-- statement boundaries are clear and greedy expressions don't need parens.
prettyDoStmt :: DoStmt -> Doc ann
prettyDoStmt :: forall ann. DoStmt -> Doc ann
prettyDoStmt DoStmt
stmt =
  case DoStmt
stmt of
    DoBind SourceSpan
_ Pattern
pat Expr
expr -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
expr
    DoLet SourceSpan
_ [(Text, Expr)]
bindings -> Doc ann
"let" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi (((Text, Expr) -> Doc ann) -> [(Text, Expr)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Expr) -> Doc ann
forall ann. (Text, Expr) -> Doc ann
prettyBinding [(Text, Expr)]
bindings)))
    DoLetDecls SourceSpan
_ [Decl]
decls -> Doc ann
"let" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Decl] -> Doc ann
forall ann. [Decl] -> Doc ann
prettyInlineDecls [Decl]
decls)
    DoExpr SourceSpan
_ Expr
expr -> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
expr

prettyCompStmt :: CompStmt -> Doc ann
prettyCompStmt :: forall ann. CompStmt -> Doc ann
prettyCompStmt CompStmt
stmt =
  case CompStmt
stmt of
    CompGen SourceSpan
_ Pattern
pat Expr
expr -> Pattern -> Doc ann
forall ann. Pattern -> Doc ann
prettyPattern Pattern
pat Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
expr
    CompGuard SourceSpan
_ Expr
expr -> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
expr
    CompLet SourceSpan
_ [(Text, Expr)]
bindings -> Doc ann
"let" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi (((Text, Expr) -> Doc ann) -> [(Text, Expr)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Expr) -> Doc ann
forall ann. (Text, Expr) -> Doc ann
prettyBinding [(Text, Expr)]
bindings))
    CompLetDecls SourceSpan
_ [Decl]
decls -> Doc ann
"let" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Decl] -> Doc ann
forall ann. [Decl] -> Doc ann
prettyInlineDecls [Decl]
decls)

prettyInlineDecls :: [Decl] -> Doc ann
prettyInlineDecls :: forall ann. [Decl] -> Doc ann
prettyInlineDecls [Decl]
decls =
  [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi ((Decl -> Doc ann) -> [Decl] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Decl -> Doc ann
forall {ann}. Decl -> Doc ann
prettyInlineDecl [Decl]
decls))
  where
    -- For value declarations, use single-line form to keep guarded bindings together.
    -- For other declarations, join their lines with spaces.
    prettyInlineDecl :: Decl -> Doc ann
prettyInlineDecl Decl
decl = case Decl
decl of
      DeclValue SourceSpan
_ ValueDecl
valueDecl -> ValueDecl -> Doc ann
forall ann. ValueDecl -> Doc ann
prettyValueDeclSingleLine ValueDecl
valueDecl
      Decl
_ -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Decl -> [Doc ann]
forall ann. Decl -> [Doc ann]
prettyDeclLines Decl
decl)

prettyArithSeq :: ArithSeq -> Doc ann
prettyArithSeq :: forall ann. ArithSeq -> Doc ann
prettyArithSeq ArithSeq
seqInfo =
  case ArithSeq
seqInfo of
    ArithSeqFrom SourceSpan
_ Expr
fromExpr -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Expr -> Doc ann
forall ann. Expr -> Doc ann
prettyExprGuarded Expr
fromExpr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" ..")
    ArithSeqFromThen SourceSpan
_ Expr
fromExpr Expr
thenExpr -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Expr -> Doc ann
forall ann. Expr -> Doc ann
prettyExprGuarded Expr
fromExpr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
", " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Expr -> Doc ann
forall ann. Expr -> Doc ann
prettyExprGuarded Expr
thenExpr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" ..")
    ArithSeqFromTo SourceSpan
_ Expr
fromExpr Expr
toExpr -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Expr -> Doc ann
forall ann. Expr -> Doc ann
prettyExprGuarded Expr
fromExpr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" .. " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
toExpr)
    ArithSeqFromThenTo SourceSpan
_ Expr
fromExpr Expr
thenExpr Expr
toExpr ->
      Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Expr -> Doc ann
forall ann. Expr -> Doc ann
prettyExprGuarded Expr
fromExpr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
", " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Expr -> Doc ann
forall ann. Expr -> Doc ann
prettyExprGuarded Expr
thenExpr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" .. " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Expr -> Doc ann
forall ann. Int -> Expr -> Doc ann
prettyExprPrec Int
0 Expr
toExpr)

parenthesize :: Bool -> Doc ann -> Doc ann
parenthesize :: forall ann. Bool -> Doc ann -> Doc ann
parenthesize Bool
shouldWrap Doc ann
doc
  | Bool
shouldWrap = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens Doc ann
doc
  | Bool
otherwise = Doc ann
doc

quoted :: Text -> Doc ann
quoted :: forall ann. Text -> Doc ann
quoted Text
txt = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> String
forall a. Show a => a -> String
show (Text -> String
T.unpack Text
txt))

prettyQuasiQuote :: Text -> Text -> Doc ann
prettyQuasiQuote :: forall ann. Text -> Text -> Doc ann
prettyQuasiQuote Text
quoter Text
body = Doc ann
"[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
quoter Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"|" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
body Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"|]"

isOperatorToken :: Text -> Bool
isOperatorToken :: Text -> Bool
isOperatorToken Text
tok =
  Bool -> Bool
not (Text -> Bool
T.null Text
tok) Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
":!#$%&*+./<=>?\\^|-~" :: String)) Text
tok