    {-# LANGUAGE CPP #-}
    module Happy.Frontend.PrettyGrammar where

    #if MIN_VERSION_base(4,11,0)
    import Prelude hiding ((<>))
    #endif
    import Happy.Frontend.AbsSyn

    render :: Doc -> String
    render :: Doc -> String
    render = String -> (ShowS -> String) -> Doc -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "" (ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ String
    "")

    ppAbsSyn :: AbsSyn String -> Doc
    ppAbsSyn :: AbsSyn String -> Doc
    ppAbsSyn (AbsSyn [Directive String]
    ds [Rule String]
    rs) = [Doc] -> Doc
    vsep ([Doc] -> Doc
    vcat ((Directive String -> Doc) -> [Directive String] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Directive String -> Doc
    forall a. Directive a -> Doc
    ppDirective [Directive String]
    ds) Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : (Rule String -> Doc) -> [Rule String] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Rule String -> Doc
    ppRule [Rule String]
    rs)

    ppDirective :: Directive a -> Doc
    ppDirective :: forall a. Directive a -> Doc
    ppDirective Directive a
    dir =
      case Directive a
    dir of
        TokenNonassoc [String]
    xs -> String -> [String] -> Doc
    prec String
    "%nonassoc" [String]
    xs
        TokenRight [String]
    xs    -> String -> [String] -> Doc
    prec String
    "%right" [String]
    xs
        TokenLeft [String]
    xs     -> String -> [String] -> Doc
    prec String
    "%left" [String]
    xs
        Directive a
    _                -> Doc
    empty
      where
      prec :: String -> [String] -> Doc
    prec String
    x [String]
    xs = String -> Doc
    text String
    x Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    hsep ((String -> Doc) -> [String] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Doc
    text [String]
    xs)

    ppRule :: Rule String -> Doc
    ppRule :: Rule String -> Doc
    ppRule (Rule String
    name [String]
    _ [Prod String]
    prods Maybe String
    _) = String -> Doc
    text String
    name
                                Doc -> Doc -> Doc
    $$ [Doc] -> Doc
    vcat ((Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Doc -> Doc -> Doc
    (<+>) [Doc]
    starts ((Prod String -> Doc) -> [Prod String] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Prod String -> Doc
    ppProd [Prod String]
    prods))
      where
      starts :: [Doc]
    starts = String -> Doc
    text String
    "  :" Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : Doc -> [Doc]
    forall a. a -> [a]
    repeat (String -> Doc
    text String
    "  |")

    ppProd :: Prod String -> Doc
    ppProd :: Prod String -> Doc
    ppProd (Prod [Term]
    ts String
    _ Int
    _ Prec
    p) = Doc
    psDoc Doc -> Doc -> Doc
    <+> Prec -> Doc
    ppPrec Prec
    p
      where
      psDoc :: Doc
    psDoc   = if [Term] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Term]
    ts then String -> Doc
    text String
    "{- empty -}" else [Doc] -> Doc
    hsep ((Term -> Doc) -> [Term] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Term -> Doc
    ppTerm [Term]
    ts)

    ppPrec :: Prec -> Doc
    ppPrec :: Prec -> Doc
    ppPrec Prec
    PrecNone   = Doc
    empty
    ppPrec Prec
    PrecShift  = String -> Doc
    text String
    "%shift"
    ppPrec (PrecId String
    x) = String -> Doc
    text String
    "%prec" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    x

    ppTerm :: Term -> Doc
    ppTerm :: Term -> Doc
    ppTerm (App String
    x [Term]
    ts) = String -> Doc
    text String
    x Doc -> Doc -> Doc
    <> [Doc] -> Doc
    ppTuple ((Term -> Doc) -> [Term] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Term -> Doc
    ppTerm [Term]
    ts)

    ppTuple :: [Doc] -> Doc
    ppTuple :: [Doc] -> Doc
    ppTuple [] = Doc
    empty
    ppTuple [Doc]
    xs = Doc -> Doc
    parens ([Doc] -> Doc
    hsep (Doc -> [Doc] -> [Doc]
    punctuate Doc
    comma [Doc]
    xs))

    --------------------------------------------------------------------------------
    -- Pretty printing combinator

    type Doc = Maybe ShowS

    empty :: Doc
    empty :: Doc
    empty = Doc
    forall a. Maybe a
    Nothing

    punctuate :: Doc -> [Doc] -> [Doc]
    punctuate :: Doc -> [Doc] -> [Doc]
    punctuate Doc
    _ []  = []
    punctuate Doc
    _ [Doc
    x] = [Doc
    x]
    punctuate Doc
    sep (Doc
    x : [Doc]
    xs) = (Doc
    x Doc -> Doc -> Doc
    <> Doc
    sep) Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : Doc -> [Doc] -> [Doc]
    punctuate Doc
    sep [Doc]
    xs

    comma ::  Doc
    comma :: Doc
    comma = Char -> Doc
    char Char
    ','

    char :: Char -> Doc
    char :: Char -> Doc
    char Char
    x = ShowS -> Doc
    forall a. a -> Maybe a
    Just (Char -> ShowS
    showChar Char
    x)

    text :: String -> Doc
    text :: String -> Doc
    text String
    x = if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    x then Doc
    forall a. Maybe a
    Nothing else ShowS -> Doc
    forall a. a -> Maybe a
    Just (String -> ShowS
    showString String
    x)

    (<+>) :: Doc -> Doc -> Doc
    Doc
    Nothing <+> :: Doc -> Doc -> Doc
    <+> Doc
    y     = Doc
    y
    Doc
    x <+> Doc
    Nothing     = Doc
    x
    Doc
    x <+> Doc
    y           = Doc
    x Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    ' ' Doc -> Doc -> Doc
    <> Doc
    y

    (<>) :: Doc -> Doc -> Doc
    Doc
    Nothing <> :: Doc -> Doc -> Doc
    <> Doc
    y = Doc
    y
    Doc
    x <> Doc
    Nothing = Doc
    x
    Just ShowS
    x <> Just ShowS
    y = ShowS -> Doc
    forall a. a -> Maybe a
    Just (ShowS
    x ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    y)

    ($$) :: Doc -> Doc -> Doc
    Doc
    Nothing $$ :: Doc -> Doc -> Doc
    $$ Doc
    y = Doc
    y
    Doc
    x $$ Doc
    Nothing = Doc
    x
    Doc
    x $$ Doc
    y       = Doc
    x Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    '\n' Doc -> Doc -> Doc
    <> Doc
    y

    hsep :: [Doc] -> Doc
    hsep :: [Doc] -> Doc
    hsep = [Doc] -> Doc
    hcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> [Doc] -> [Doc]
    punctuate (Char -> Doc
    char Char
    ' ')

    vcat :: [Doc] -> Doc
    vcat :: [Doc] -> Doc
    vcat = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Doc -> Doc -> Doc
    ($$) Doc
    empty

    vsep :: [Doc] -> Doc
    vsep :: [Doc] -> Doc
    vsep = [Doc] -> Doc
    vcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> [Doc] -> [Doc]
    punctuate (Char -> Doc
    char Char
    '\n')

    parens :: Doc -> Doc
    parens :: Doc -> Doc
    parens Doc
    x = Char -> Doc
    char Char
    '(' Doc -> Doc -> Doc
    <> Doc
    x Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    ')'

    hcat :: [Doc] -> Doc
    hcat :: [Doc] -> Doc
    hcat = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Doc -> Doc -> Doc
    (<>) Doc
    empty