summaryrefslogtreecommitdiff
path: root/.gitlab/hello.hs
blob: 2837cac62d6a827ae695c89d4aedf3f70b6c8fc7 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
{-# OPTIONS_GHC -Wno-missing-fields #-}

import GHC hiding (parseModule)
import GHC.Data.StringBuffer
import GHC.Driver.Config.Parser
import GHC.Parser
import GHC.Parser.Lexer
import GHC.Platform
import GHC.Plugins
import GHC.Settings
import GHC.Settings.Config

fakeSettings :: Settings
fakeSettings =
  Settings
    { sGhcNameVersion =
        GhcNameVersion
          { ghcNameVersion_programName =
              "ghc",
            ghcNameVersion_projectVersion =
              cProjectVersion
          },
      sFileSettings =
        FileSettings {},
      sToolSettings = ToolSettings {},
      sTargetPlatform =
        genericPlatform,
      sPlatformMisc = PlatformMisc {}
    }

fakeDynFlags :: DynFlags
fakeDynFlags = defaultDynFlags fakeSettings

parse :: DynFlags -> String -> IO (Located (HsModule GhcPs))
parse dflags src = do
  let buf = stringToStringBuffer src
  let loc = mkRealSrcLoc (mkFastString "Main.hs") 1 1
  case unP parseModule (initParserState (initParserOpts dflags) buf loc) of
    PFailed _ -> fail "parseModule failed"
    POk _ rdr_module -> pure rdr_module

main :: IO ()
main = do
  m <- parse fakeDynFlags "main = putStrLn \"hello world\""
  putStrLn $ showSDoc fakeDynFlags $ ppr m