content: -- Copyright 2019 Google LLC
  --
  -- Use of this source code is governed by a BSD-style
  -- license that can be found in the LICENSE file or at
  -- https://developers.google.com/open-source/licenses/bsd
  
  -- | Simple example using this package
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE NoMonomorphismRestriction #-}
  module Main (main) where
  
  import GHC.Paths (libdir)
  import GHC (runGhc)
  import GHC.Utils.Outputable (Outputable)
  
  import GHC.SourceGen
  
  main :: IO ()
  main = mapM_ run [test1, test2, test3, test4, test5]
    where
      run act = putStrLn "========" >> act
  
  pprint :: Outputable a => a -> IO ()
  pprint x = runGhc (Just libdir) $ putPpr x
  
  test1 :: IO ()
  test1 = pprint $ tuple
      [ var "Foo.abc"
      , overLabel "def"
      , char 'g'
      , let' [ typeSig "result" $ var "A" @@ var "B"
             , funBind "result"
                  $ match [bvar "x", wildP]
                      $ var "foo" @@ char 'c'
             ]
          (var "result")
      ]
  
  test2 :: IO ()
  test2 = pprint $ module' (Just "Foo") (Just [var "efg"]) []
      [ typeSigs ["efg", "h"] $ tuple [var "A", var "B"]
      , funBind "efg"
          $ matchGRHSs []
          $ rhs (char 'a')
              `where'` [ typeSig "q" $ var "Q"
                       , funBind "q" $ matchGRHSs []
                          $ guardedRhs [var "True" `guard` char 'q']
                       ]
      , funBind "f"
          $ matchGRHSs [bvar "x", bvar "y"]
          $ rhs
              (case' (var "y")
                          [match [wildP] $ var "x"])
              `where'` [funBind "q" $ match [] $ char 't']
      ]
  
  test3 :: IO ()
  test3 = pprint $ module' Nothing Nothing []
      [ funBind "lambdas" $ match [] $ lambda [bvar "y"]
                      $ lambdaCase [match [bvar "z"] (char 'a')]
      , funBinds "ifs"
          [ match [bvar "x"] $ if' (var "b") (var "t") (var "f")
          , match [bvar "y"] $ multiIf [guard (var "False") $ char 'f'
                                         , guard (var "True") $ char 't'
                                         ]
          , match [bvar "z"] $ multiIf
              [ guard (var "f" @@ var "x") $ string "f"
              , guard (var "g" @@ var "x") $ string "g"
              , guard (var "otherwise") $ string "h"
              ]
          ]
      , funBind "do'"
          $ match [] (do' [ bvar "x" <-- var "act"
                          , stmt $ var "return" @@ var "x"
                          ])
      , typeSig "types"
          $ forall' [bvar "x", bvar "y"]
          $ [var "Show" @@ var "x"] ==> var "y"
      , typeSig "types'"
          $ [var "Show" @@ var "x"] ==>
              (forall' [bvar "x", bvar "y"]
                  $ var "y")
      , funBind "swap"
          $ match [tuple [bvar "x", bvar "y"]]
              $ tuple [var "y", var "x"]
      , funBind "char" $ match [char 'a'] (char 'b')
      , funBind "string" $ match [string "abc"] (string "def")
      , funBind "as"
          $ match [asP "x" (tuple [bvar "y", bvar "z"])]
              (var "x")
      , funBind "con"
          $ match [conP "A" [bvar "b", conP "C" [bvar "d"]]]
              $ tuple [var "b", var "d"]
      , funBind "ops"
          $ match [bvar "x", bvar "y"]
              $ op (var "x") "+" (var "y")
      , funBinds "ops'"
          [ match [] (op (int 1) "*"
                          (op (int 2) "+" (int 3)))
          , match [] (op (var "A" @@ var "x") "*"
                          (op (var "B" @@ var "y") "+"
                                   (var "C" @@ var "z")))
          , match [] (op (var "A" @@ var "x") "mult"
                          (op (var "B" @@ var "y") "+"
                                   (var "C" @@ var "z")))
          ]
      , funBinds "cons'"
          [ match [] (var "X" @@ int 1 @@
                          (var "Y" @@ int 2 @@ int 3)
                          @@ var "Z")
          , match [] (var "f" @@ par (var "g" @@ var "x"))
          ]
      , typeSig "f" $ var "X" @@ var "a" @@
                          (var "Y" @@ var "b" @@ var "c")
                          @@ var "Z"
      , typeSig "g" $ op (var "A" @@ var "x") "*"
                          (op (var "B" @@ var "y") "+"
                                   (var "C" @@ var "z"))
      , class' [var "A" @@ var "a"] "B" [bvar "b", bvar "b'"]
          [ typeSig "f" $ var "b" --> var "b'"
          , funBind "f" $ match [] $ var "id"
          ]
      , class' [] "F" [bvar "a", bvar "b", bvar "c"]
          [ funDep ["a", "b"] ["c"]
          , funDep ["a"] ["b", "c"]
          ]
      , class' [] "Ident" [bvar "a", bvar "b"]
          [ funDep ["a"] ["b"]
          , funDep ["b"] ["a"]
          , typeSig "ident" $ var "a" --> var "b"
          ]
      , type' "A" [bvar "b", bvar "c"] $ var "D"
      , data' "A" [bvar "b", bvar "c"]
          [ prefixCon "A" [field (var "b"), field (var "c")]
          , prefixCon "D" []
          ]
          [deriving' [var "X", var "Y"]]
      , newtype' "A" [bvar "b", bvar "c"] (prefixCon "A" [field (var "b")])
          [deriving' [var "X", var "Y"]]
      , instance' (var "A" @@ var "b" @@ var "c")
          [ typeSig "f" $ var "b" --> var "c"
          , funBind "f" $ match [] $ var "undefined"
          ]
      , let a = var "a"
        in class'
             [var "Real" @@ a, var "Enum" @@ a]
             "Integral"
             [bvar "a"]
             [ typeSig "divMod" $ a --> a --> tuple [a, a]
             , typeSig "div" $ a --> a --> a
             , funBind "div"
                 $ match [bvar "x", bvar "y"]
                    $ var "fst" @@ (var "divMod" @@ var "x" @@ var "y")
             ]
      , instance' (var "Show" @@ var "Bool")
          [ typeSig "show" $ var "Bool" --> var "String"
          , funBinds "show"
              [ match [conP "True" []] $ string "True"
              , match [conP "False" []] $ string "False"
              ]
          ]
      , data' "X" [bvar "b"]
          [ prefixCon "X"
              [ field $ var "A" @@ var "b"
              , strict $ field $ var "A" @@ var "b"
              , lazy $ field $ var "A" @@ var "b"
              ]
          , prefixCon ":+"
              [ field $ var "A" @@ var "b"
              , strict $ field $ var "A" @@ var "b"
              , lazy $ field $ var "A" @@ var "b"
              ]
          , infixCon
              (strict $ field $ var "A" @@ var "b")
              "Y"
              (lazy $ field $ var "A" @@ var "b")
          , infixCon
              (strict $ field $ var "A" @@ var "b")
              ":*"
              (lazy $ field $ var "A" @@ var "b")
          , infixCon
              (field $ var "A" @@ var "b")
              ":*"
              (field $ var "A" @@ var "b")
          , recordCon "Z"
              [ ("x", field $ var "Int")
              , ("y", field $ var "A" @@ var "b")
              , ("y", strict $ field $ var "A" @@ var "b")
              , ("y", lazy $ field $ var "A" @@ var "b")
              ]
          ]
          []
      , funBind "strictness"
          $ match
              [strictP (conP "A" [bvar "b"]),
               lazyP (conP "A" [bvar "b"])
              ] (char 'x')
      , typeSig "unit" $ unit --> unit
      , funBind "unit" $ match [unit] unit
      ]
  
  test4 :: IO ()
  test4 = pprint constModule
  
  test5 :: IO ()
  test5 = pprint $ module' (Just "M") (Just exports) imports []
    where
      exports = [ var "a"
                , var "A"
                , thingAll "B"
                , thingWith "C" ["d", "E"]
                ]
      imports = [ qualified' $ import' "A"
                , import' "B" `as'` "C"
                , import' "D" `exposing` [var "d"]
                , import' "E" `hiding` [var "e"]
                ]
  
  constModule :: HsModule'
  constModule = module' (Just "Const") (Just [var "const"]) []
      [ typeSig "const" $ a --> b --> a
      , funBind "const" $ match [wildP, x] x
      ]
    where
      a = bvar "a"
      b = bvar "b"
      x = bvar "x"
  