1{-# LANGUAGE RecordWildCards #-}
2
3-- | A type for result of parsing.
4module Ormolu.Parser.Result
5  ( ParseResult (..),
6    prettyPrintParseResult,
7  )
8where
9
10import Data.Text (Text)
11import GHC
12import Ormolu.Parser.Anns
13import Ormolu.Parser.CommentStream
14import Ormolu.Parser.Pragma (Pragma)
15import Ormolu.Parser.Shebang (Shebang)
16
17-- | A collection of data that represents a parsed module in Ormolu.
18data ParseResult = ParseResult
19  { -- | 'ParsedSource' from GHC
20    prParsedSource :: HsModule GhcPs,
21    -- | Ormolu-specfic representation of annotations
22    prAnns :: Anns,
23    -- | Stack header
24    prStackHeader :: Maybe (RealLocated Comment),
25    -- | Shebangs found in the input
26    prShebangs :: [Shebang],
27    -- | Pragmas and the associated comments
28    prPragmas :: [([RealLocated Comment], Pragma)],
29    -- | Comment stream
30    prCommentStream :: CommentStream,
31    -- | Whether or not record dot syntax is enabled
32    prUseRecordDot :: Bool,
33    -- | Whether or not ImportQualifiedPost is enabled
34    prImportQualifiedPost :: Bool,
35    -- | Literal prefix
36    prLiteralPrefix :: Text,
37    -- | Literal suffix
38    prLiteralSuffix :: Text,
39    -- | Indentation level, can be non-zero in case of region formatting
40    prIndent :: Int
41  }
42
43-- | Pretty-print a 'ParseResult'.
44prettyPrintParseResult :: ParseResult -> String
45prettyPrintParseResult ParseResult {..} =
46  unlines
47    [ "parse result:",
48      "  comment stream:",
49      showCommentStream prCommentStream
50      -- XXX extend as needed
51    ]
52