    ------------------------------------------------------------------------
    -- Pretty-printing of Haskell modules
    ------------------------------------------------------------------------

    module Agda.Compiler.MAlonzo.Pretty where

    import qualified Agda.Utils.Haskell.Syntax as HS
    import Text.PrettyPrint (empty)

    import Agda.Compiler.MAlonzo.Encode
    import Agda.Utils.Pretty

    prettyPrint :: Pretty a => a -> String
    prettyPrint :: forall a. Pretty a => a -> String
    prettyPrint = Doc -> String
    forall a. Show a => a -> String
    show (Doc -> String) -> (a -> Doc) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Doc
    forall a. Pretty a => a -> Doc
    pretty

    instance Pretty HS.Module where
      pretty :: Module -> Doc
    pretty (HS.Module ModuleName
    m [ModulePragma]
    pragmas [ImportDecl]
    imps [Decl]
    decls) =
        [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [[Doc]] -> [Doc]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
          [ (ModulePragma -> Doc) -> [ModulePragma] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map ModulePragma -> Doc
    forall a. Pretty a => a -> Doc
    pretty [ModulePragma]
    pragmas
          , [ Doc
    "" | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [ModulePragma] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ModulePragma]
    pragmas ]
          , [ Doc
    "module" Doc -> Doc -> Doc
    <+> ModuleName -> Doc
    forall a. Pretty a => a -> Doc
    pretty ModuleName
    m Doc -> Doc -> Doc
    <+> Doc
    "where" ]
          , [ Doc
    "" ]
          , (ImportDecl -> Doc) -> [ImportDecl] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map ImportDecl -> Doc
    forall a. Pretty a => a -> Doc
    pretty [ImportDecl]
    imps
          , [ Doc
    "" ]
          , (Decl -> Doc) -> [Decl] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Decl -> Doc
    forall a. Pretty a => a -> Doc
    pretty [Decl]
    decls
          ]

    instance Pretty HS.ModulePragma where
      pretty :: ModulePragma -> Doc
    pretty (HS.LanguagePragma [Name]
    ps) =
        Doc
    "{-#" Doc -> Doc -> Doc
    <+> Doc
    "LANGUAGE" Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    fsep (Doc -> [Doc] -> [Doc]
    forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
    punctuate Doc
    comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ (Name -> Doc) -> [Name] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Doc
    forall a. Pretty a => a -> Doc
    pretty [Name]
    ps) Doc -> Doc -> Doc
    <+> Doc
    "#-}"
      pretty (HS.OtherPragma String
    p) =
        String -> Doc
    text String
    p

    instance Pretty HS.ImportDecl where
      pretty :: ImportDecl -> Doc
    pretty HS.ImportDecl{ importModule :: ImportDecl -> ModuleName
    HS.importModule    = ModuleName
    m
                          , importQualified :: ImportDecl -> Bool
    HS.importQualified = Bool
    q
                          , importSpecs :: ImportDecl -> Maybe (Bool, [ImportSpec])
    HS.importSpecs     = Maybe (Bool, [ImportSpec])
    specs } =
          [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    hsep [ Doc
    "import"
               , if Bool
    q then Doc
    "qualified" else Doc
    empty
               , ModuleName -> Doc
    forall a. Pretty a => a -> Doc
    pretty ModuleName
    m
               , Doc
    -> ((Bool, [ImportSpec]) -> Doc)
    -> Maybe (Bool, [ImportSpec])
    -> Doc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Doc
    empty (Bool, [ImportSpec]) -> Doc
    forall {a}. Pretty a => (Bool, [a]) -> Doc
    prSpecs Maybe (Bool, [ImportSpec])
    specs ]
        where prSpecs :: (Bool, [a]) -> Doc
    prSpecs (Bool
    hide, [a]
    specs) =
                [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    hsep [ if Bool
    hide then Doc
    "hiding" else Doc
    empty
                     , Doc -> Doc
    parens (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    fsep ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ Doc -> [Doc] -> [Doc]
    forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
    punctuate Doc
    comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ (a -> Doc) -> [a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Doc
    forall a. Pretty a => a -> Doc
    pretty [a]
    specs ]

    instance Pretty HS.ImportSpec where
      pretty :: ImportSpec -> Doc
    pretty (HS.IVar Name
    x) = Name -> Doc
    forall a. Pretty a => a -> Doc
    pretty Name
    x

    instance Pretty HS.Decl where
      pretty :: Decl -> Doc
    pretty = \case
        HS.TypeDecl Name
    f [TyVarBind]
    xs Type
    t ->
          [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Doc
    "type" Doc -> Doc -> Doc
    <+> Name -> Doc
    forall a. Pretty a => a -> Doc
    pretty Name
    f Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    fsep ((TyVarBind -> Doc) -> [TyVarBind] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map TyVarBind -> Doc
    forall a. Pretty a => a -> Doc
    pretty [TyVarBind]
    xs) Doc -> Doc -> Doc
    <+> Doc
    "="
              , Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Type -> Doc
    forall a. Pretty a => a -> Doc
    pretty Type
    t ]
        HS.DataDecl DataOrNew
    newt Name
    d [TyVarBind]
    xs [ConDecl]
    cons [Deriving]
    derv ->
          [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ DataOrNew -> Doc
    forall a. Pretty a => a -> Doc
    pretty DataOrNew
    newt Doc -> Doc -> Doc
    <+> Name -> Doc
    forall a. Pretty a => a -> Doc
    pretty Name
    d Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    fsep ((TyVarBind -> Doc) -> [TyVarBind] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map TyVarBind -> Doc
    forall a. Pretty a => a -> Doc
    pretty [TyVarBind]
    xs)
              , Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ if [ConDecl] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ConDecl]
    cons then Doc
    empty
                         else Doc
    "=" Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    fsep (Doc -> [Doc] -> [Doc]
    forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
    punctuate Doc
    " |" ([Doc] -> [Doc]) -> [Doc] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ (ConDecl -> Doc) -> [ConDecl] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map ConDecl -> Doc
    forall a. Pretty a => a -> Doc
    pretty [ConDecl]
    cons)
              , Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Deriving] -> Doc
    forall {t :: * -> *}. Foldable t => [(QName, t Type)] -> Doc
    prDeriving [Deriving]
    derv ]
          where
            prDeriving :: [(QName, t Type)] -> Doc
    prDeriving [] = Doc
    empty
            prDeriving [(QName, t Type)]
    ds = Doc
    "deriving" Doc -> Doc -> Doc
    <+> Doc -> Doc
    parens ([Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    fsep ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ Doc -> [Doc] -> [Doc]
    forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
    punctuate Doc
    comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ ((QName, t Type) -> Doc) -> [(QName, t Type)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (QName, t Type) -> Doc
    forall {t :: * -> *}. Foldable t => (QName, t Type) -> Doc
    prDer [(QName, t Type)]
    ds)
            prDer :: (QName, t Type) -> Doc
    prDer (QName
    d, t Type
    ts) = Type -> Doc
    forall a. Pretty a => a -> Doc
    pretty ((Type -> Type -> Type) -> Type -> t Type -> Type
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Type -> Type -> Type
    HS.TyApp (QName -> Type
    HS.TyCon QName
    d) t Type
    ts)
        HS.TypeSig [Name]
    fs Type
    t ->
          [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    hsep (Doc -> [Doc] -> [Doc]
    forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
    punctuate Doc
    comma ((Name -> Doc) -> [Name] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Doc
    forall a. Pretty a => a -> Doc
    pretty [Name]
    fs)) Doc -> Doc -> Doc
    <+> Doc
    "::"
              , Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Type -> Doc
    forall a. Pretty a => a -> Doc
    pretty Type
    t ]
        HS.FunBind [Match]
    ms -> [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (Match -> Doc) -> [Match] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Match -> Doc
    forall a. Pretty a => a -> Doc
    pretty [Match]
    ms
        HS.LocalBind Strictness
    s Name
    f Rhs
    rhs ->
          [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Strictness -> Doc
    forall a. Pretty a => a -> Doc
    pretty Strictness
    s Doc -> Doc -> Doc
    forall a. Semigroup a => a -> a -> a
    <> Name -> Doc
    forall a. Pretty a => a -> Doc
    pretty Name
    f
              , Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ String -> Rhs -> Doc
    prettyRhs String
    "=" Rhs
    rhs
              ]
        HS.PatSyn Pat
    p1 Pat
    p2 -> [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Doc
    "pattern" Doc -> Doc -> Doc
    <+> Pat -> Doc
    forall a. Pretty a => a -> Doc
    pretty Pat
    p1 Doc -> Doc -> Doc
    <+> Doc
    "=" Doc -> Doc -> Doc
    <+> Pat -> Doc
    forall a. Pretty a => a -> Doc
    pretty Pat
    p2 ]
        HS.FakeDecl String
    s -> String -> Doc
    text String
    s
        HS.Comment String
    s -> [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (String -> Doc) -> [String] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Doc
    "--" Doc -> Doc -> Doc
    <+>) (Doc -> Doc) -> (String -> Doc) -> String -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Doc
    text) (String -> [String]
    lines String
    s)

    instance Pretty HS.ConDecl where
      pretty :: ConDecl -> Doc
    pretty (HS.ConDecl Name
    c [(Maybe Strictness, Type)]
    sts) =
        Name -> Doc
    forall a. Pretty a => a -> Doc
    pretty Name
    c Doc -> Doc -> Doc
    <+>
        [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    fsep (((Maybe Strictness, Type) -> Doc)
    -> [(Maybe Strictness, Type)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Maybe Strictness
    s, Type
    t) -> Doc -> (Strictness -> Doc) -> Maybe Strictness -> Doc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Doc
    empty Strictness -> Doc
    forall a. Pretty a => a -> Doc
    pretty Maybe Strictness
    s Doc -> Doc -> Doc
    forall a. Semigroup a => a -> a -> a
    <> Int -> Type -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    10 Type
    t) [(Maybe Strictness, Type)]
    sts)

    instance Pretty HS.Strictness where
      pretty :: Strictness -> Doc
    pretty Strictness
    HS.Strict = Doc
    "!"
      pretty Strictness
    HS.Lazy   = Doc
    empty

    instance Pretty HS.Match where
      pretty :: Match -> Doc
    pretty (HS.Match Name
    f [Pat]
    ps Rhs
    rhs Maybe Binds
    wh) =
        Maybe Binds -> Doc -> Doc
    prettyWhere Maybe Binds
    wh (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
          [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Name -> Doc
    forall a. Pretty a => a -> Doc
    pretty Name
    f Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    fsep ((Pat -> Doc) -> [Pat] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Pat -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    10) [Pat]
    ps)
              , Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ String -> Rhs -> Doc
    prettyRhs String
    "=" Rhs
    rhs ]

    prettyWhere :: Maybe HS.Binds -> Doc -> Doc
    prettyWhere :: Maybe Binds -> Doc -> Doc
    prettyWhere Maybe Binds
    Nothing  Doc
    doc = Doc
    doc
    prettyWhere (Just Binds
    b) Doc
    doc =
      [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    vcat [ Doc
    doc, Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Doc
    "where", Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Binds -> Doc
    forall a. Pretty a => a -> Doc
    pretty Binds
    b ] ]

    instance Pretty HS.Pat where
      prettyPrec :: Int -> Pat -> Doc
    prettyPrec Int
    pr Pat
    pat =
        case Pat
    pat of
          HS.PVar Name
    x         -> Name -> Doc
    forall a. Pretty a => a -> Doc
    pretty Name
    x
          HS.PLit Literal
    l         -> Int -> Literal -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    pr Literal
    l
          HS.PAsPat Name
    x Pat
    p     -> Bool -> Doc -> Doc
    mparens (Int
    pr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    10) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Name -> Doc
    forall a. Pretty a => a -> Doc
    pretty Name
    x Doc -> Doc -> Doc
    forall a. Semigroup a => a -> a -> a
    <> Doc
    "@" Doc -> Doc -> Doc
    forall a. Semigroup a => a -> a -> a
    <> Int -> Pat -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    11 Pat
    p
          Pat
    HS.PWildCard      -> Doc
    "_"
          HS.PBangPat Pat
    p     -> Doc
    "!" Doc -> Doc -> Doc
    forall a. Semigroup a => a -> a -> a
    <> Int -> Pat -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    11 Pat
    p
          HS.PApp QName
    c [Pat]
    ps      -> Bool -> Doc -> Doc
    mparens (Int
    pr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    9) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ QName -> Doc
    forall a. Pretty a => a -> Doc
    pretty QName
    c Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    hsep ((Pat -> Doc) -> [Pat] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Pat -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    10) [Pat]
    ps)
          HS.PatTypeSig Pat
    p Type
    t -> Bool -> Doc -> Doc
    mparens (Int
    pr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Pat -> Doc
    forall a. Pretty a => a -> Doc
    pretty Pat
    p Doc -> Doc -> Doc
    <+> Doc
    "::", Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Type -> Doc
    forall a. Pretty a => a -> Doc
    pretty Type
    t ]
          HS.PIrrPat Pat
    p      -> Bool -> Doc -> Doc
    mparens (Int
    pr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    10) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Doc
    "~" Doc -> Doc -> Doc
    forall a. Semigroup a => a -> a -> a
    <> Int -> Pat -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    11 Pat
    p

    prettyRhs :: String -> HS.Rhs -> Doc
    prettyRhs :: String -> Rhs -> Doc
    prettyRhs String
    eq (HS.UnGuardedRhs Exp
    e)   = String -> Doc
    text String
    eq Doc -> Doc -> Doc
    <+> Exp -> Doc
    forall a. Pretty a => a -> Doc
    pretty Exp
    e
    prettyRhs String
    eq (HS.GuardedRhss [GuardedRhs]
    rhss) = [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (GuardedRhs -> Doc) -> [GuardedRhs] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> GuardedRhs -> Doc
    prettyGuardedRhs String
    eq) [GuardedRhs]
    rhss

    prettyGuardedRhs :: String -> HS.GuardedRhs -> Doc
    prettyGuardedRhs :: String -> GuardedRhs -> Doc
    prettyGuardedRhs String
    eq (HS.GuardedRhs [Stmt]
    ss Exp
    e) =
        [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Doc
    "|" Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep (Doc -> [Doc] -> [Doc]
    forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
    punctuate Doc
    comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ (Stmt -> Doc) -> [Stmt] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Stmt -> Doc
    forall a. Pretty a => a -> Doc
    pretty [Stmt]
    ss) Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    eq
            , Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Exp -> Doc
    forall a. Pretty a => a -> Doc
    pretty Exp
    e ]

    instance Pretty HS.Binds where
      pretty :: Binds -> Doc
    pretty (HS.BDecls [Decl]
    ds) = [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (Decl -> Doc) -> [Decl] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Decl -> Doc
    forall a. Pretty a => a -> Doc
    pretty [Decl]
    ds

    instance Pretty HS.DataOrNew where
      pretty :: DataOrNew -> Doc
    pretty DataOrNew
    HS.DataType = Doc
    "data"
      pretty DataOrNew
    HS.NewType  = Doc
    "newtype"

    instance Pretty HS.TyVarBind where
      pretty :: TyVarBind -> Doc
    pretty (HS.UnkindedVar Name
    x) = Name -> Doc
    forall a. Pretty a => a -> Doc
    pretty Name
    x

    instance Pretty HS.Type where
      prettyPrec :: Int -> Type -> Doc
    prettyPrec Int
    pr Type
    t =
        case Type
    t of
          HS.TyForall [TyVarBind]
    xs Type
    t ->
            Bool -> Doc -> Doc
    mparens (Int
    pr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
              [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ (Doc
    "forall" Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    fsep ((TyVarBind -> Doc) -> [TyVarBind] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map TyVarBind -> Doc
    forall a. Pretty a => a -> Doc
    pretty [TyVarBind]
    xs)) Doc -> Doc -> Doc
    forall a. Semigroup a => a -> a -> a
    <> Doc
    "."
                  , Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Type -> Doc
    forall a. Pretty a => a -> Doc
    pretty Type
    t ]
          HS.TyFun Type
    a Type
    b ->
            Bool -> Doc -> Doc
    mparens (Int
    pr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    4) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
              [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Int -> Type -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    5 Type
    a Doc -> Doc -> Doc
    <+> Doc
    "->", Int -> Type -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    4 Type
    b ]
          HS.TyCon QName
    c -> QName -> Doc
    forall a. Pretty a => a -> Doc
    pretty QName
    c
          HS.TyVar Name
    x -> Name -> Doc
    forall a. Pretty a => a -> Doc
    pretty Name
    x
          HS.TyApp (HS.TyCon (HS.UnQual (HS.Ident String
    "[]"))) Type
    t ->
            Doc -> Doc
    brackets (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Type -> Doc
    forall a. Pretty a => a -> Doc
    pretty Type
    t
          t :: Type
    t@HS.TyApp{} ->
            Bool -> Doc -> Doc
    mparens (Int
    pr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    9) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
              [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Int -> Type -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    9 Type
    f
                  , Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    fsep ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (Type -> Doc) -> [Type] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Type -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    10) [Type]
    ts ]
            where
              Type
    f : [Type]
    ts = Type -> [Type] -> [Type]
    appView Type
    t []
              appView :: Type -> [Type] -> [Type]
    appView (HS.TyApp Type
    a Type
    b) [Type]
    as = Type -> [Type] -> [Type]
    appView Type
    a (Type
    b Type -> [Type] -> [Type]
    forall a. a -> [a] -> [a]
    : [Type]
    as)
              appView Type
    t [Type]
    as = Type
    t Type -> [Type] -> [Type]
    forall a. a -> [a] -> [a]
    : [Type]
    as
          HS.FakeType String
    s -> String -> Doc
    text String
    s

    instance Pretty HS.Stmt where
      pretty :: Stmt -> Doc
    pretty (HS.Qualifier Exp
    e) = Exp -> Doc
    forall a. Pretty a => a -> Doc
    pretty Exp
    e
      pretty (HS.Generator Pat
    p Exp
    e) = [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Pat -> Doc
    forall a. Pretty a => a -> Doc
    pretty Pat
    p Doc -> Doc -> Doc
    <+> Doc
    "<-", Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Exp -> Doc
    forall a. Pretty a => a -> Doc
    pretty Exp
    e ]

    instance Pretty HS.Literal where
      prettyPrec :: Int -> Literal -> Doc
    prettyPrec Int
    pr = \case
        HS.Int Integer
    n    -> Integer -> Doc -> Doc
    forall n. (Ord n, Num n) => n -> Doc -> Doc
    parensIfNeg Integer
    n (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Integer -> Doc
    integer Integer
    n
        HS.Frac Rational
    x   -> Double -> Doc -> Doc
    forall n. (Ord n, Num n) => n -> Doc -> Doc
    parensIfNeg Double
    d (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Double -> Doc
    double Double
    d
                       where
                       d :: Double
    d = Rational -> Double
    forall a. Fractional a => Rational -> a
    fromRational Rational
    x
        HS.Char Char
    c   -> String -> Doc
    text (Char -> String
    forall a. Show a => a -> String
    show Char
    c)
        HS.String Text
    s -> String -> Doc
    text (Text -> String
    forall a. Show a => a -> String
    show Text
    s)
        where
        parensIfNeg :: (Ord n, Num n) => n -> Doc -> Doc
        parensIfNeg :: forall n. (Ord n, Num n) => n -> Doc -> Doc
    parensIfNeg n
    x =
          if n
    x n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    < n
    0 then Bool -> Doc -> Doc
    mparens (Int
    pr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    10) else Doc -> Doc
    forall a. a -> a
    id

    instance Pretty HS.Exp where
      prettyPrec :: Int -> Exp -> Doc
    prettyPrec Int
    pr Exp
    e =
        case Exp
    e of
          HS.Var QName
    x -> QName -> Doc
    forall a. Pretty a => a -> Doc
    pretty QName
    x
          HS.Con QName
    c -> QName -> Doc
    forall a. Pretty a => a -> Doc
    pretty QName
    c
          HS.Lit Literal
    l -> Literal -> Doc
    forall a. Pretty a => a -> Doc
    pretty Literal
    l
          HS.InfixApp Exp
    a QOp
    qop Exp
    b -> Bool -> Doc -> Doc
    mparens (Int
    pr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
            [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Int -> Exp -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    1 Exp
    a
                , QOp -> Doc
    forall a. Pretty a => a -> Doc
    pretty QOp
    qop Doc -> Doc -> Doc
    <+> Int -> Exp -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    1 Exp
    b ]
          HS.Ann Exp
    e Type
    ty -> Bool -> Doc -> Doc
    mparens (Int
    pr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
            [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Int -> Exp -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    1 Exp
    e
                , Doc
    "::"
                , Int -> Type -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    1 Type
    ty
                ]
          HS.App{} -> Bool -> Doc -> Doc
    mparens (Int
    pr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    9) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
            [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Int -> Exp -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    9 Exp
    f
                , Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    fsep ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (Exp -> Doc) -> [Exp] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Exp -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    10) [Exp]
    es ]
            where
              Exp
    f : [Exp]
    es = Exp -> [Exp] -> [Exp]
    appView Exp
    e []
              appView :: Exp -> [Exp] -> [Exp]
    appView (HS.App Exp
    f Exp
    e) [Exp]
    es = Exp -> [Exp] -> [Exp]
    appView Exp
    f (Exp
    e Exp -> [Exp] -> [Exp]
    forall a. a -> [a] -> [a]
    : [Exp]
    es)
              appView Exp
    f [Exp]
    es = Exp
    f Exp -> [Exp] -> [Exp]
    forall a. a -> [a] -> [a]
    : [Exp]
    es
          HS.Lambda [Pat]
    ps Exp
    e -> Bool -> Doc -> Doc
    mparens (Int
    pr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
            [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Doc
    "\\" Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    fsep ((Pat -> Doc) -> [Pat] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Pat -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    10) [Pat]
    ps) Doc -> Doc -> Doc
    <+> Doc
    "->"
                , Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Exp -> Doc
    forall a. Pretty a => a -> Doc
    pretty Exp
    e ]
          HS.Let Binds
    bs Exp
    e -> Bool -> Doc -> Doc
    mparens (Int
    pr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
            [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Doc
    "let" Doc -> Doc -> Doc
    <+> Binds -> Doc
    forall a. Pretty a => a -> Doc
    pretty Binds
    bs Doc -> Doc -> Doc
    <+> Doc
    "in"
                , Exp -> Doc
    forall a. Pretty a => a -> Doc
    pretty Exp
    e ]
          HS.If Exp
    a Exp
    b Exp
    c -> Bool -> Doc -> Doc
    mparens (Int
    pr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
            [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Doc
    "if" Doc -> Doc -> Doc
    <+> Exp -> Doc
    forall a. Pretty a => a -> Doc
    pretty Exp
    a
                , Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Doc
    "then" Doc -> Doc -> Doc
    <+> Exp -> Doc
    forall a. Pretty a => a -> Doc
    pretty Exp
    b
                , Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Doc
    "else" Doc -> Doc -> Doc
    <+> Int -> Exp -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    1 Exp
    c ]
          HS.Case Exp
    e [Alt]
    bs -> Bool -> Doc -> Doc
    mparens (Int
    pr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
            [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    vcat [ Doc
    "case" Doc -> Doc -> Doc
    <+> Exp -> Doc
    forall a. Pretty a => a -> Doc
    pretty Exp
    e Doc -> Doc -> Doc
    <+> Doc
    "of"
                 , Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (Alt -> Doc) -> [Alt] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Alt -> Doc
    forall a. Pretty a => a -> Doc
    pretty [Alt]
    bs ]
          HS.ExpTypeSig Exp
    e Type
    t -> Bool -> Doc -> Doc
    mparens (Int
    pr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
            [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Exp -> Doc
    forall a. Pretty a => a -> Doc
    pretty Exp
    e Doc -> Doc -> Doc
    <+> Doc
    "::"
                , Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Type -> Doc
    forall a. Pretty a => a -> Doc
    pretty Type
    t ]
          HS.NegApp Exp
    exp -> Doc -> Doc
    parens (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Doc
    "-" Doc -> Doc -> Doc
    forall a. Semigroup a => a -> a -> a
    <> Exp -> Doc
    forall a. Pretty a => a -> Doc
    pretty Exp
    exp
          HS.FakeExp String
    s -> String -> Doc
    text String
    s

    instance Pretty HS.Alt where
      pretty :: Alt -> Doc
    pretty (HS.Alt Pat
    pat Rhs
    rhs Maybe Binds
    wh) =
        Maybe Binds -> Doc -> Doc
    prettyWhere Maybe Binds
    wh (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
          [Doc] -> Doc
    forall (t :: * -> *). Foldable t => t Doc -> Doc
    sep [ Pat -> Doc
    forall a. Pretty a => a -> Doc
    pretty Pat
    pat, Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ String -> Rhs -> Doc
    prettyRhs String
    "->" Rhs
    rhs ]

    instance Pretty HS.ModuleName where
      pretty :: ModuleName -> Doc
    pretty ModuleName
    m = String -> Doc
    text String
    s
        where HS.ModuleName String
    s = ModuleName -> ModuleName
    encodeModuleName ModuleName
    m

    instance Pretty HS.QName where
      pretty :: QName -> Doc
    pretty QName
    q = Bool -> Doc -> Doc
    mparens (QName -> Bool
    isOperator QName
    q) (QName -> Doc
    prettyQName QName
    q)

    instance Pretty HS.Name where
      pretty :: Name -> Doc
    pretty (HS.Ident  String
    s) = String -> Doc
    text String
    s
      pretty (HS.Symbol String
    s) = String -> Doc
    text String
    s

    instance Pretty HS.QOp where
      pretty :: QOp -> Doc
    pretty (HS.QVarOp QName
    x)
        | QName -> Bool
    isOperator QName
    x = QName -> Doc
    prettyQName QName
    x
        | Bool
    otherwise    = Doc
    "`" Doc -> Doc -> Doc
    forall a. Semigroup a => a -> a -> a
    <> QName -> Doc
    prettyQName QName
    x Doc -> Doc -> Doc
    forall a. Semigroup a => a -> a -> a
    <> Doc
    "`"

    isOperator :: HS.QName -> Bool
    isOperator :: QName -> Bool
    isOperator QName
    q =
      case QName
    q of
        HS.Qual ModuleName
    _ Name
    x           -> Name -> Bool
    isOp Name
    x
        HS.UnQual Name
    x           -> Name -> Bool
    isOp Name
    x
      where
        isOp :: Name -> Bool
    isOp HS.Symbol{} = Bool
    True
        isOp HS.Ident{}  = Bool
    False

    prettyQName :: HS.QName -> Doc
    prettyQName :: QName -> Doc
    prettyQName (HS.Qual ModuleName
    m Name
    x)           = ModuleName -> Doc
    forall a. Pretty a => a -> Doc
    pretty ModuleName
    m Doc -> Doc -> Doc
    forall a. Semigroup a => a -> a -> a
    <> Doc
    "." Doc -> Doc -> Doc
    forall a. Semigroup a => a -> a -> a
    <> Name -> Doc
    forall a. Pretty a => a -> Doc
    pretty Name
    x
    prettyQName (HS.UnQual Name
    x)           = Name -> Doc
    forall a. Pretty a => a -> Doc
    pretty Name
    x