{-# LANGUAGE RecordWildCards #-}

-- | A type for result of parsing.
module Ormolu.Parser.Result
  ( ParseResult (..),
    prettyPrintParseResult,
  )
where

import Data.Text (Text)
import GHC
import Ormolu.Parser.Anns
import Ormolu.Parser.CommentStream
import Ormolu.Parser.Pragma (Pragma)
import Ormolu.Parser.Shebang (Shebang)

-- | A collection of data that represents a parsed module in Ormolu.
data ParseResult = ParseResult
  { -- | 'ParsedSource' from GHC
    ParseResult -> HsModule GhcPs
prParsedSource :: HsModule GhcPs,
    -- | Ormolu-specfic representation of annotations
    ParseResult -> Anns
prAnns :: Anns,
    -- | Stack header
    ParseResult -> Maybe (RealLocated Comment)
prStackHeader :: Maybe (RealLocated Comment),
    -- | Shebangs found in the input
    ParseResult -> [Shebang]
prShebangs :: [Shebang],
    -- | Pragmas and the associated comments
    ParseResult -> [([RealLocated Comment], Pragma)]
prPragmas :: [([RealLocated Comment], Pragma)],
    -- | Comment stream
    ParseResult -> CommentStream
prCommentStream :: CommentStream,
    -- | Whether or not record dot syntax is enabled
    ParseResult -> Bool
prUseRecordDot :: Bool,
    -- | Whether or not ImportQualifiedPost is enabled
    ParseResult -> Bool
prImportQualifiedPost :: Bool,
    -- | Literal prefix
    ParseResult -> Text
prLiteralPrefix :: Text,
    -- | Literal suffix
    ParseResult -> Text
prLiteralSuffix :: Text,
    -- | Indentation level, can be non-zero in case of region formatting
    ParseResult -> Int
prIndent :: Int
  }

-- | Pretty-print a 'ParseResult'.
prettyPrintParseResult :: ParseResult -> String
prettyPrintParseResult :: ParseResult -> String
prettyPrintParseResult ParseResult {Bool
Int
[([RealLocated Comment], Pragma)]
[Shebang]
Maybe (RealLocated Comment)
HsModule GhcPs
Text
Anns
CommentStream
prIndent :: Int
prLiteralSuffix :: Text
prLiteralPrefix :: Text
prImportQualifiedPost :: Bool
prUseRecordDot :: Bool
prCommentStream :: CommentStream
prPragmas :: [([RealLocated Comment], Pragma)]
prShebangs :: [Shebang]
prStackHeader :: Maybe (RealLocated Comment)
prAnns :: Anns
prParsedSource :: HsModule GhcPs
prIndent :: ParseResult -> Int
prLiteralSuffix :: ParseResult -> Text
prLiteralPrefix :: ParseResult -> Text
prImportQualifiedPost :: ParseResult -> Bool
prUseRecordDot :: ParseResult -> Bool
prCommentStream :: ParseResult -> CommentStream
prPragmas :: ParseResult -> [([RealLocated Comment], Pragma)]
prShebangs :: ParseResult -> [Shebang]
prStackHeader :: ParseResult -> Maybe (RealLocated Comment)
prAnns :: ParseResult -> Anns
prParsedSource :: ParseResult -> HsModule GhcPs
..} =
  [String] -> String
unlines
    [ String
"parse result:",
      String
"  comment stream:",
      CommentStream -> String
showCommentStream CommentStream
prCommentStream
      -- XXX extend as needed
    ]