{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}

-- | Pretty printing.

module HIndent.Pretty
  (pretty)
  where

import           Control.Applicative
import           Control.Monad.State.Strict hiding (state)
import qualified Data.ByteString.Builder as S
import           Data.Foldable (for_, forM_, traverse_)
import           Data.Int
import           Data.List
import           Data.Maybe
import           Data.Monoid ((<>))
import           Data.Typeable
import           HIndent.Types
import qualified Language.Haskell.Exts as P
import           Language.Haskell.Exts.SrcLoc
import           Language.Haskell.Exts.Syntax
import           Prelude hiding (exp)

--------------------------------------------------------------------------------
-- * Pretty printing class

-- | Pretty printing class.
class (Annotated ast,Typeable ast) => Pretty ast where
  prettyInternal :: ast NodeInfo -> Printer ()

-- | Pretty print including comments.
pretty :: (Pretty ast,Show (ast NodeInfo))
       => ast NodeInfo -> Printer ()
pretty :: ast NodeInfo -> Printer ()
pretty ast NodeInfo
a = do
  (NodeComment -> Printer ()) -> [NodeComment] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    (\NodeComment
c' -> do
       case NodeComment
c' of
         CommentBeforeLine SrcSpan
_ SomeComment
c -> do
           case SomeComment
c of
             EndOfLine String
s -> String -> Printer ()
write (String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
             MultiLine String
s -> String -> Printer ()
write (String
"{-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-}")
           Printer ()
newline
         NodeComment
_ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    [NodeComment]
comments
  ast NodeInfo -> Printer ()
forall (ast :: * -> *). Pretty ast => ast NodeInfo -> Printer ()
prettyInternal ast NodeInfo
a
  ((Int, NodeComment) -> Printer ())
-> [(Int, NodeComment)] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    (\(Int
i, NodeComment
c') -> do
       case NodeComment
c' of
         CommentSameLine SrcSpan
spn SomeComment
c -> do
           Int64
col <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psColumn
           if Int64
col Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
             then do
               -- write comment keeping original indentation
               let col' :: Int64
col' = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Int
srcSpanStartColumn SrcSpan
spn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
               Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column Int64
col' (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ SomeComment -> Printer ()
writeComment SomeComment
c
             else do
               Printer ()
space
               SomeComment -> Printer ()
writeComment SomeComment
c
         CommentAfterLine SrcSpan
spn SomeComment
c -> do
           Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) Printer ()
newline
           -- write comment keeping original indentation
           let col :: Int64
col = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Int
srcSpanStartColumn SrcSpan
spn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
           Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column Int64
col (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ SomeComment -> Printer ()
writeComment SomeComment
c
         NodeComment
_ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    ([Int] -> [NodeComment] -> [(Int, NodeComment)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [NodeComment]
comments)
  where
    comments :: [NodeComment]
comments = NodeInfo -> [NodeComment]
nodeInfoComments (ast NodeInfo -> NodeInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann ast NodeInfo
a)
    writeComment :: SomeComment -> Printer ()
writeComment =
      \case
        EndOfLine String
cs -> do
          String -> Printer ()
write (String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs)
          (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
            (\PrintState
s ->
                PrintState
s
                { psEolComment :: Bool
psEolComment = Bool
True
                })
        MultiLine String
cs -> do
          String -> Printer ()
write (String
"{-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-}")
          (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
            (\PrintState
s ->
                PrintState
s
                { psEolComment :: Bool
psEolComment = Bool
True
                })

-- | Pretty print using HSE's own printer. The 'P.Pretty' class here
-- is HSE's.
pretty' :: (Pretty ast,P.Pretty (ast SrcSpanInfo))
        => ast NodeInfo -> Printer ()
pretty' :: ast NodeInfo -> Printer ()
pretty' = String -> Printer ()
write (String -> Printer ())
-> (ast NodeInfo -> String) -> ast NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ast SrcSpanInfo -> String
forall a. Pretty a => a -> String
P.prettyPrint (ast SrcSpanInfo -> String)
-> (ast NodeInfo -> ast SrcSpanInfo) -> ast NodeInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeInfo -> SrcSpanInfo) -> ast NodeInfo -> ast SrcSpanInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeInfo -> SrcSpanInfo
nodeInfoSpan

--------------------------------------------------------------------------------
-- * Combinators

-- | Increase indentation level by n spaces for the given printer.
indented :: Int64 -> Printer a -> Printer a
indented :: Int64 -> Printer a -> Printer a
indented Int64
i Printer a
p =
  do Int64
level <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psIndentLevel
     (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s {psIndentLevel :: Int64
psIndentLevel = Int64
level Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
i})
     a
m <- Printer a
p
     (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s {psIndentLevel :: Int64
psIndentLevel = Int64
level})
     a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return a
m

indentedBlock :: Printer a -> Printer a
indentedBlock :: Printer a -> Printer a
indentedBlock Printer a
p =
  do Int64
indentSpaces <- Printer Int64
getIndentSpaces
     Int64 -> Printer a -> Printer a
forall a. Int64 -> Printer a -> Printer a
indented Int64
indentSpaces Printer a
p

-- | Print all the printers separated by spaces.
spaced :: [Printer ()] -> Printer ()
spaced :: [Printer ()] -> Printer ()
spaced = Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space

-- | Print all the printers separated by commas.
commas :: [Printer ()] -> Printer ()
commas :: [Printer ()] -> Printer ()
commas = Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
", ")

-- | Print all the printers separated by sep.
inter :: Printer () -> [Printer ()] -> Printer ()
inter :: Printer () -> [Printer ()] -> Printer ()
inter Printer ()
sep [Printer ()]
ps =
  ((Int, Printer ()) -> Printer () -> Printer ())
-> Printer () -> [(Int, Printer ())] -> Printer ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    (\(Int
i,Printer ()
p) Printer ()
next ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
          (do Printer ()
p
              if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Printer ()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Printer ()]
ps
                then Printer ()
sep
                else () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
          Printer ()
next)
    (() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    ([Int] -> [Printer ()] -> [(Int, Printer ())]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [Printer ()]
ps)

-- | Print all the printers separated by newlines.
lined :: [Printer ()] -> Printer ()
lined :: [Printer ()] -> Printer ()
lined [Printer ()]
ps = [Printer ()] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
intersperse Printer ()
newline [Printer ()]
ps)

-- | Print all the printers separated newlines and optionally a line
-- prefix.
prefixedLined :: String -> [Printer ()] -> Printer ()
prefixedLined :: String -> [Printer ()] -> Printer ()
prefixedLined String
pref [Printer ()]
ps' =
  case [Printer ()]
ps' of
    [] -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Printer ()
p:[Printer ()]
ps) ->
      do Printer ()
p
         Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                     (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
pref Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                      (-Int
1)))
                  ((Printer () -> Printer ()) -> [Printer ()] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Printer ()
p' ->
                            do Printer ()
newline
                               Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
pref) Printer ()
p')
                         [Printer ()]
ps)

-- | Set the (newline-) indent level to the given column for the given
-- printer.
column :: Int64 -> Printer a -> Printer a
column :: Int64 -> Printer a -> Printer a
column Int64
i Printer a
p =
  do Int64
level <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psIndentLevel
     (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s {psIndentLevel :: Int64
psIndentLevel = Int64
i})
     a
m <- Printer a
p
     (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s {psIndentLevel :: Int64
psIndentLevel = Int64
level})
     a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return a
m

-- | Output a newline.
newline :: Printer ()
newline :: Printer ()
newline =
  do String -> Printer ()
write String
"\n"
     (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s {psNewline :: Bool
psNewline = Bool
True})

-- | Set the context to a case context, where RHS is printed with -> .
withCaseContext :: Bool -> Printer a -> Printer a
withCaseContext :: Bool -> Printer a -> Printer a
withCaseContext Bool
bool Printer a
pr =
  do Bool
original <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psInsideCase
     (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s {psInsideCase :: Bool
psInsideCase = Bool
bool})
     a
result <- Printer a
pr
     (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s {psInsideCase :: Bool
psInsideCase = Bool
original})
     a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

-- | Get the current RHS separator, either = or -> .
rhsSeparator :: Printer ()
rhsSeparator :: Printer ()
rhsSeparator =
  do Bool
inCase <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psInsideCase
     if Bool
inCase
        then String -> Printer ()
write String
"->"
        else String -> Printer ()
write String
"="

-- | Make the latter's indentation depend upon the end column of the
-- former.
depend :: Printer () -> Printer b -> Printer b
depend :: Printer () -> Printer b -> Printer b
depend Printer ()
maker Printer b
dependent =
  do PrintState
state' <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
     Printer ()
maker
     PrintState
st <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
     Int64
col <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psColumn
     if PrintState -> Int64
psLine PrintState
state' Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= PrintState -> Int64
psLine PrintState
st Bool -> Bool -> Bool
|| PrintState -> Int64
psColumn PrintState
state' Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= PrintState -> Int64
psColumn PrintState
st
        then Int64 -> Printer b -> Printer b
forall a. Int64 -> Printer a -> Printer a
column Int64
col Printer b
dependent
        else Printer b
dependent

-- | Wrap.
wrap :: String -> String -> Printer a -> Printer a
wrap :: String -> String -> Printer a -> Printer a
wrap String
open String
close Printer a
p = Printer () -> Printer a -> Printer a
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
open) (Printer a -> Printer a) -> Printer a -> Printer a
forall a b. (a -> b) -> a -> b
$ Printer a
p Printer a -> Printer () -> Printer a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Printer ()
write String
close

-- | Wrap in parens.
parens :: Printer a -> Printer a
parens :: Printer a -> Printer a
parens = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap String
"(" String
")"

-- | Wrap in braces.
braces :: Printer a -> Printer a
braces :: Printer a -> Printer a
braces = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap String
"{" String
"}"

-- | Wrap in brackets.
brackets :: Printer a -> Printer a
brackets :: Printer a -> Printer a
brackets = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap String
"[" String
"]"

-- | Write a space.
space :: Printer ()
space :: Printer ()
space = String -> Printer ()
write String
" "

-- | Write a comma.
comma :: Printer ()
comma :: Printer ()
comma = String -> Printer ()
write String
","

-- | Write an integral.
int :: Integer -> Printer ()
int :: Integer -> Printer ()
int = String -> Printer ()
write (String -> Printer ())
-> (Integer -> String) -> Integer -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show

-- | Write out a string, updating the current position information.
write :: String -> Printer ()
write :: String -> Printer ()
write String
x =
  do Bool
eol <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psEolComment
     Bool
hardFail <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psFitOnOneLine
     let addingNewline :: Bool
addingNewline = Bool
eol Bool -> Bool -> Bool
&& String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"\n"
     Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
addingNewline Printer ()
newline
     PrintState
state <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
     let writingNewline :: Bool
writingNewline = String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"\n"
         out :: String
         out :: String
out =
           if PrintState -> Bool
psNewline PrintState
state Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
writingNewline
              then (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PrintState -> Int64
psIndentLevel PrintState
state))
                               Char
' ') String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                   String
x
              else String
x
         psColumn' :: Int64
psColumn' =
            if Int
additionalLines Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
               then Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
srclines))))
               else PrintState -> Int64
psColumn PrintState
state Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
out)
     Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
       Bool
hardFail
       (Bool -> Printer ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard
          (Int
additionalLines Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&&
           (Int64
psColumn' Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Config -> Int64
configMaxColumns (PrintState -> Config
psConfig PrintState
state))))
     (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s ->
               PrintState
s {psOutput :: Builder
psOutput = PrintState -> Builder
psOutput PrintState
state Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
S.stringUtf8 String
out
                 ,psNewline :: Bool
psNewline = Bool
False
                 ,psLine :: Int64
psLine = PrintState -> Int64
psLine PrintState
state Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
additionalLines
                 ,psEolComment :: Bool
psEolComment= Bool
False
                 ,psColumn :: Int64
psColumn = Int64
psColumn'})
  where srclines :: [String]
srclines = String -> [String]
lines String
x
        additionalLines :: Int
additionalLines =
          String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') String
x)

-- | Write a string.
string :: String -> Printer ()
string :: String -> Printer ()
string = String -> Printer ()
write

-- | Indent spaces, e.g. 2.
getIndentSpaces :: Printer Int64
getIndentSpaces :: Printer Int64
getIndentSpaces =
  (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Config -> Int64
configIndentSpaces (Config -> Int64) -> (PrintState -> Config) -> PrintState -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintState -> Config
psConfig)

-- | Play with a printer and then restore the state to what it was
-- before.
sandbox :: Printer a -> Printer (a,PrintState)
sandbox :: Printer a -> Printer (a, PrintState)
sandbox Printer a
p =
  do PrintState
orig <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
     a
a <- Printer a
p
     PrintState
new <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
     PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
orig
     (a, PrintState) -> Printer (a, PrintState)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,PrintState
new)

-- | Render a type with a context, or not.
withCtx :: (Pretty ast,Show (ast NodeInfo))
        => Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx :: Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (ast NodeInfo)
Nothing Printer b
m = Printer b
m
withCtx (Just ast NodeInfo
ctx) Printer b
m =
  do ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ast NodeInfo
ctx
     String -> Printer ()
write String
" =>"
     Printer ()
newline
     Printer b
m

-- | Maybe render an overlap definition.
maybeOverlap ::  Maybe (Overlap NodeInfo) -> Printer ()
maybeOverlap :: Maybe (Overlap NodeInfo) -> Printer ()
maybeOverlap =
  Printer ()
-> (Overlap NodeInfo -> Printer ())
-> Maybe (Overlap NodeInfo)
-> Printer ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        (\Overlap NodeInfo
p ->
           Overlap NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Overlap NodeInfo
p Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
           Printer ()
space)

-- | Swing the second printer below and indented with respect to the first.
swing :: Printer () -> Printer b -> Printer ()
swing :: Printer () -> Printer b -> Printer ()
swing Printer ()
a Printer b
b =
  do Int64
orig <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psIndentLevel
     Printer ()
a
     Maybe PrintState
mst <- Printer b -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (do Printer ()
space
                              Printer b
b)
     case Maybe PrintState
mst of
       Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
       Maybe PrintState
Nothing -> do Printer ()
newline
                     Int64
indentSpaces <- Printer Int64
getIndentSpaces
                     b
_ <- Int64 -> Printer b -> Printer b
forall a. Int64 -> Printer a -> Printer a
column (Int64
orig Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
indentSpaces) Printer b
b
                     () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Swing the second printer below and indented with respect to the first by
-- the specified amount.
swingBy :: Int64 -> Printer() -> Printer b -> Printer b
swingBy :: Int64 -> Printer () -> Printer b -> Printer b
swingBy Int64
i Printer ()
a Printer b
b =
  do Int64
orig <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psIndentLevel
     Printer ()
a
     Printer ()
newline
     Int64 -> Printer b -> Printer b
forall a. Int64 -> Printer a -> Printer a
column (Int64
orig Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
i) Printer b
b

--------------------------------------------------------------------------------
-- * Instances

instance Pretty Context where
  prettyInternal :: Context NodeInfo -> Printer ()
prettyInternal ctx :: Context NodeInfo
ctx@(CxTuple NodeInfo
_ [Asst NodeInfo]
asserts) = do
    Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> [Printer ()] -> Printer ()
inter (Printer ()
comma Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space) ((Asst NodeInfo -> Printer ()) -> [Asst NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Asst NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Asst NodeInfo]
asserts)))
    case Maybe PrintState
mst of
      Maybe PrintState
Nothing -> Context NodeInfo -> Printer ()
context Context NodeInfo
ctx
      Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
  prettyInternal Context NodeInfo
ctx = Context NodeInfo -> Printer ()
context Context NodeInfo
ctx

instance Pretty Pat where
  prettyInternal :: Pat NodeInfo -> Printer ()
prettyInternal Pat NodeInfo
x =
    case Pat NodeInfo
x of
      PLit NodeInfo
_ Sign NodeInfo
sign Literal NodeInfo
l -> Sign NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Sign NodeInfo
sign Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Literal NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Literal NodeInfo
l
      PNPlusK NodeInfo
_ Name NodeInfo
n Integer
k ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
n
                   String -> Printer ()
write String
"+")
               (Integer -> Printer ()
int Integer
k)
      PInfixApp NodeInfo
_ Pat NodeInfo
a QName NodeInfo
op Pat NodeInfo
b ->
        case QName NodeInfo
op of
          Special{} ->
            Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
a)
                   (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (QName NodeInfo -> Printer ()
prettyInfixOp QName NodeInfo
op)
                           (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
b))
          QName NodeInfo
_ ->
            Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
a
                       Printer ()
space)
                   (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do QName NodeInfo -> Printer ()
prettyInfixOp QName NodeInfo
op
                               Printer ()
space)
                           (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
b))
      PApp NodeInfo
_ QName NodeInfo
f [Pat NodeInfo]
args ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
f
                   Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Pat NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pat NodeInfo]
args) Printer ()
space)
               ([Printer ()] -> Printer ()
spaced ((Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
args))
      PTuple NodeInfo
_ Boxed
boxed [Pat NodeInfo]
pats ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write (case Boxed
boxed of
                         Boxed
Unboxed -> String
"(# "
                         Boxed
Boxed -> String
"("))
               (do [Printer ()] -> Printer ()
commas ((Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
pats)
                   String -> Printer ()
write (case Boxed
boxed of
                            Boxed
Unboxed -> String
" #)"
                            Boxed
Boxed -> String
")"))
      PList NodeInfo
_ [Pat NodeInfo]
ps ->
        Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets ([Printer ()] -> Printer ()
commas ((Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
ps))
      PParen NodeInfo
_ Pat NodeInfo
e -> Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
e)
      PRec NodeInfo
_ QName NodeInfo
qname [PatField NodeInfo]
fields -> do
        let horVariant :: Printer ()
horVariant = do
              QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname
              Printer ()
space
              Printer () -> Printer ()
forall a. Printer a -> Printer a
braces (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
commas ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (PatField NodeInfo -> Printer ())
-> [PatField NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map PatField NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [PatField NodeInfo]
fields
            verVariant :: Printer ()
verVariant =
              Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
                case [PatField NodeInfo]
fields of
                  [] -> String -> Printer ()
write String
"{}"
                  [PatField NodeInfo
field] -> Printer () -> Printer ()
forall a. Printer a -> Printer a
braces (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ PatField NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty PatField NodeInfo
field
                  [PatField NodeInfo]
_ -> do
                    Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"{") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
                      String -> [Printer ()] -> Printer ()
prefixedLined String
"," ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (PatField NodeInfo -> Printer ())
-> [PatField NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (PatField NodeInfo -> Printer ())
-> PatField NodeInfo
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatField NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [PatField NodeInfo]
fields
                    Printer ()
newline
                    String -> Printer ()
write String
"}"
        Printer ()
horVariant Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVariant
      PAsPat NodeInfo
_ Name NodeInfo
n Pat NodeInfo
p ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
n
                   String -> Printer ()
write String
"@")
               (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
      PWildCard NodeInfo
_ -> String -> Printer ()
write String
"_"
      PIrrPat NodeInfo
_ Pat NodeInfo
p ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"~")
               (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
      PatTypeSig NodeInfo
_ Pat NodeInfo
p Type NodeInfo
ty ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p
                   String -> Printer ()
write String
" :: ")
               (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
      PViewPat NodeInfo
_ Exp NodeInfo
e Pat NodeInfo
p ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
                   String -> Printer ()
write String
" -> ")
               (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
      PQuasiQuote NodeInfo
_ String
name String
str -> String -> Printer () -> Printer ()
quotation String
name (String -> Printer ()
string String
str)
      PBangPat NodeInfo
_ Pat NodeInfo
p ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"!")
               (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
      PRPat{} -> Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Pat NodeInfo
x
      PXTag{} -> Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Pat NodeInfo
x
      PXETag{} -> Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Pat NodeInfo
x
      PXPcdata{} -> Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Pat NodeInfo
x
      PXPatTag{} -> Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Pat NodeInfo
x
      PXRPats{} -> Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Pat NodeInfo
x
      PVar{} -> Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Pat NodeInfo
x
      PSplice NodeInfo
_ Splice NodeInfo
s -> Splice NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Splice NodeInfo
s

-- | Pretty infix application of a name (identifier or symbol).
prettyInfixName :: Name NodeInfo -> Printer ()
prettyInfixName :: Name NodeInfo -> Printer ()
prettyInfixName (Ident NodeInfo
_ String
n) = do String -> Printer ()
write String
"`"; String -> Printer ()
string String
n; String -> Printer ()
write String
"`";
prettyInfixName (Symbol NodeInfo
_ String
s) = String -> Printer ()
string String
s

-- | Pretty print a name for being an infix operator.
prettyInfixOp ::  QName NodeInfo -> Printer ()
prettyInfixOp :: QName NodeInfo -> Printer ()
prettyInfixOp QName NodeInfo
x =
  case QName NodeInfo
x of
    Qual NodeInfo
_ ModuleName NodeInfo
mn Name NodeInfo
n ->
      case Name NodeInfo
n of
        Ident NodeInfo
_ String
i -> do String -> Printer ()
write String
"`"; ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
mn; String -> Printer ()
write String
"."; String -> Printer ()
string String
i; String -> Printer ()
write String
"`";
        Symbol NodeInfo
_ String
s -> do ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
mn; String -> Printer ()
write String
"."; String -> Printer ()
string String
s;
    UnQual NodeInfo
_ Name NodeInfo
n -> Name NodeInfo -> Printer ()
prettyInfixName Name NodeInfo
n
    Special NodeInfo
_ SpecialCon NodeInfo
s -> SpecialCon NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty SpecialCon NodeInfo
s

prettyQuoteName :: Name NodeInfo -> Printer ()
prettyQuoteName :: Name NodeInfo -> Printer ()
prettyQuoteName Name NodeInfo
x =
  case Name NodeInfo
x of
    Ident NodeInfo
_ String
i -> String -> Printer ()
string String
i
    Symbol NodeInfo
_ String
s -> String -> Printer ()
string (String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")

instance Pretty Type where
  prettyInternal :: Type NodeInfo -> Printer ()
prettyInternal = Type NodeInfo -> Printer ()
typ

instance Pretty Exp where
  prettyInternal :: Exp NodeInfo -> Printer ()
prettyInternal = Exp NodeInfo -> Printer ()
exp

-- | Render an expression.
exp :: Exp NodeInfo -> Printer ()
-- | Do after lambda should swing.
exp :: Exp NodeInfo -> Printer ()
exp (Lambda NodeInfo
_ [Pat NodeInfo]
pats (Do NodeInfo
l [Stmt NodeInfo]
stmts)) =
  do
     Maybe PrintState
mst <-
          Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine
            (do String -> Printer ()
write String
"\\"
                [Printer ()] -> Printer ()
spaced ((Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
pats)
                String -> Printer ()
write String
" -> "
                Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty (NodeInfo -> [Stmt NodeInfo] -> Exp NodeInfo
forall l. l -> [Stmt l] -> Exp l
Do NodeInfo
l [Stmt NodeInfo]
stmts))
     case Maybe PrintState
mst of
       Maybe PrintState
Nothing -> Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (do String -> Printer ()
write String
"\\"
                            [Printer ()] -> Printer ()
spaced ((Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
pats)
                            String -> Printer ()
write String
" -> do")
                         ([Printer ()] -> Printer ()
lined ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
stmts))
       Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
-- | Space out tuples.
exp (Tuple NodeInfo
_ Boxed
boxed [Exp NodeInfo]
exps) = do
  let horVariant :: Printer ()
horVariant = Boxed -> Printer () -> Printer ()
forall a. Boxed -> Printer a -> Printer a
parensHorB Boxed
boxed (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
", ") ((Exp NodeInfo -> Printer ()) -> [Exp NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Exp NodeInfo]
exps)
      verVariant :: Printer ()
verVariant = Boxed -> Printer () -> Printer ()
forall a. Boxed -> Printer a -> Printer a
parensVerB Boxed
boxed (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
"," ((Exp NodeInfo -> Printer ()) -> [Exp NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (Exp NodeInfo -> Printer ()) -> Exp NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [Exp NodeInfo]
exps)
  Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine Printer ()
horVariant
  case Maybe PrintState
mst of
    Maybe PrintState
Nothing -> Printer ()
verVariant
    Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
  where
    parensHorB :: Boxed -> Printer a -> Printer a
parensHorB Boxed
Boxed = Printer a -> Printer a
forall a. Printer a -> Printer a
parens
    parensHorB Boxed
Unboxed = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap String
"(# " String
" #)"
    parensVerB :: Boxed -> Printer a -> Printer a
parensVerB Boxed
Boxed = Printer a -> Printer a
forall a. Printer a -> Printer a
parens
    parensVerB Boxed
Unboxed = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap String
"(#" String
"#)"
-- | Space out tuples.
exp (TupleSection NodeInfo
_ Boxed
boxed [Maybe (Exp NodeInfo)]
mexps) = do
  let horVariant :: Printer ()
horVariant = Boxed -> Printer () -> Printer ()
forall a. Boxed -> Printer a -> Printer a
parensHorB Boxed
boxed (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
", ") ((Maybe (Exp NodeInfo) -> Printer ())
-> [Maybe (Exp NodeInfo)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer ()
-> (Exp NodeInfo -> Printer ())
-> Maybe (Exp NodeInfo)
-> Printer ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [Maybe (Exp NodeInfo)]
mexps)
      verVariant :: Printer ()
verVariant =
        Boxed -> Printer () -> Printer ()
forall a. Boxed -> Printer a -> Printer a
parensVerB Boxed
boxed (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
"," ((Maybe (Exp NodeInfo) -> Printer ())
-> [Maybe (Exp NodeInfo)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer ()
-> (Exp NodeInfo -> Printer ())
-> Maybe (Exp NodeInfo)
-> Printer ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (Exp NodeInfo -> Printer ()) -> Exp NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty)) [Maybe (Exp NodeInfo)]
mexps)
  Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine Printer ()
horVariant
  case Maybe PrintState
mst of
    Maybe PrintState
Nothing -> Printer ()
verVariant
    Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
  where
    parensHorB :: Boxed -> Printer a -> Printer a
parensHorB Boxed
Boxed = Printer a -> Printer a
forall a. Printer a -> Printer a
parens
    parensHorB Boxed
Unboxed = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap String
"(# " String
" #)"
    parensVerB :: Boxed -> Printer a -> Printer a
parensVerB Boxed
Boxed = Printer a -> Printer a
forall a. Printer a -> Printer a
parens
    parensVerB Boxed
Unboxed = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap String
"(#" String
"#)"
exp (UnboxedSum{}) = String -> Printer ()
forall a. HasCallStack => String -> a
error String
"FIXME: No implementation for UnboxedSum."
-- | Infix apps, same algorithm as ChrisDone at the moment.
exp e :: Exp NodeInfo
e@(InfixApp NodeInfo
_ Exp NodeInfo
a QOp NodeInfo
op Exp NodeInfo
b) =
  Exp NodeInfo
-> Exp NodeInfo
-> QOp NodeInfo
-> Exp NodeInfo
-> Maybe Int64
-> Printer ()
infixApp Exp NodeInfo
e Exp NodeInfo
a QOp NodeInfo
op Exp NodeInfo
b Maybe Int64
forall a. Maybe a
Nothing
-- | If bodies are indented 4 spaces. Handle also do-notation.
exp (If NodeInfo
_ Exp NodeInfo
if' Exp NodeInfo
then' Exp NodeInfo
else') =
  do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"if ")
            (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
if')
     Printer ()
newline
     Int64
indentSpaces <- Printer Int64
getIndentSpaces
     Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
indentSpaces
              (do String -> Exp NodeInfo -> Printer ()
branch String
"then " Exp NodeInfo
then'
                  Printer ()
newline
                  String -> Exp NodeInfo -> Printer ()
branch String
"else " Exp NodeInfo
else')
     -- Special handling for do.
  where branch :: String -> Exp NodeInfo -> Printer ()
branch String
str Exp NodeInfo
e =
          case Exp NodeInfo
e of
            Do NodeInfo
_ [Stmt NodeInfo]
stmts ->
              do String -> Printer ()
write String
str
                 String -> Printer ()
write String
"do"
                 Printer ()
newline
                 Int64
indentSpaces <- Printer Int64
getIndentSpaces
                 Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
indentSpaces ([Printer ()] -> Printer ()
lined ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
stmts))
            Exp NodeInfo
_ ->
              Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
str)
                     (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
-- | Render on one line, or otherwise render the op with the arguments
-- listed line by line.
exp (App NodeInfo
_ Exp NodeInfo
op Exp NodeInfo
arg) = do
  let flattened :: [Exp NodeInfo]
flattened = Exp NodeInfo -> [Exp NodeInfo]
flatten Exp NodeInfo
op [Exp NodeInfo] -> [Exp NodeInfo] -> [Exp NodeInfo]
forall a. [a] -> [a] -> [a]
++ [Exp NodeInfo
arg]
  Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine ([Printer ()] -> Printer ()
spaced ((Exp NodeInfo -> Printer ()) -> [Exp NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Exp NodeInfo]
flattened))
  case Maybe PrintState
mst of
    Maybe PrintState
Nothing -> do
      let (Exp NodeInfo
f:[Exp NodeInfo]
args) = [Exp NodeInfo]
flattened
      Int64
col <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psColumn
      Int64
spaces <- Printer Int64
getIndentSpaces
      Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
f
      Int64
col' <- (PrintState -> Int64) -> Printer Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int64
psColumn
      let diff :: Int64
diff = Int64
col' Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
col Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- if Int64
col Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 then Int64
spaces else Int64
0
      if Int64
diff Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
spaces
        then Printer ()
space
        else Printer ()
newline
      Int64
spaces' <- Printer Int64
getIndentSpaces
      Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
spaces' ([Printer ()] -> Printer ()
lined ((Exp NodeInfo -> Printer ()) -> [Exp NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Exp NodeInfo]
args))
    Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
  where
    flatten :: Exp NodeInfo -> [Exp NodeInfo]
flatten (App NodeInfo
label' Exp NodeInfo
op' Exp NodeInfo
arg') = Exp NodeInfo -> [Exp NodeInfo]
flatten Exp NodeInfo
op' [Exp NodeInfo] -> [Exp NodeInfo] -> [Exp NodeInfo]
forall a. [a] -> [a] -> [a]
++ [(NodeInfo -> NodeInfo) -> Exp NodeInfo -> Exp NodeInfo
forall (ast :: * -> *) l.
Annotated ast =>
(l -> l) -> ast l -> ast l
amap (NodeInfo -> NodeInfo -> NodeInfo
addComments NodeInfo
label') Exp NodeInfo
arg']
    flatten Exp NodeInfo
x = [Exp NodeInfo
x]
    addComments :: NodeInfo -> NodeInfo -> NodeInfo
addComments NodeInfo
n1 NodeInfo
n2 =
      NodeInfo
n2
      { nodeInfoComments :: [NodeComment]
nodeInfoComments = [NodeComment] -> [NodeComment]
forall a. Eq a => [a] -> [a]
nub (NodeInfo -> [NodeComment]
nodeInfoComments NodeInfo
n2 [NodeComment] -> [NodeComment] -> [NodeComment]
forall a. [a] -> [a] -> [a]
++ NodeInfo -> [NodeComment]
nodeInfoComments NodeInfo
n1)
      }
-- | Space out commas in list.
exp (List NodeInfo
_ [Exp NodeInfo]
es) =
  do Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine Printer ()
p
     case Maybe PrintState
mst of
       Maybe PrintState
Nothing -> do
         Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
           (String -> Printer ()
write String
"[")
           (String -> [Printer ()] -> Printer ()
prefixedLined String
"," ((Exp NodeInfo -> Printer ()) -> [Exp NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (Exp NodeInfo -> Printer ()) -> Exp NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [Exp NodeInfo]
es))
         Printer ()
newline
         String -> Printer ()
write String
"]"
       Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
  where p :: Printer ()
p =
          Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
", ")
                          ((Exp NodeInfo -> Printer ()) -> [Exp NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Exp NodeInfo]
es))
exp (RecUpdate NodeInfo
_ Exp NodeInfo
exp' [FieldUpdate NodeInfo]
updates) = Printer () -> [FieldUpdate NodeInfo] -> Printer ()
recUpdateExpr (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
exp') [FieldUpdate NodeInfo]
updates
exp (RecConstr NodeInfo
_ QName NodeInfo
qname [FieldUpdate NodeInfo]
updates) = Printer () -> [FieldUpdate NodeInfo] -> Printer ()
recUpdateExpr (QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
qname) [FieldUpdate NodeInfo]
updates
exp (Let NodeInfo
_ Binds NodeInfo
binds Exp NodeInfo
e) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"let ")
         (do Binds NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Binds NodeInfo
binds
             Printer ()
newline
             Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented (-Int64
3) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"in ")
                                   (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)))
exp (ListComp NodeInfo
_ Exp NodeInfo
e [QualStmt NodeInfo]
qstmt) = do
  let horVariant :: Printer ()
horVariant = Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
        String -> Printer ()
write String
" | "
        [Printer ()] -> Printer ()
commas ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (QualStmt NodeInfo -> Printer ())
-> [QualStmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [QualStmt NodeInfo]
qstmt
      verVariant :: Printer ()
verVariant = do
        String -> Printer ()
write String
"[ "
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
        Printer ()
newline
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"| ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
", " ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (QualStmt NodeInfo -> Printer ())
-> [QualStmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [QualStmt NodeInfo]
qstmt
        Printer ()
newline
        String -> Printer ()
write String
"]"
  Printer ()
horVariant Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVariant

exp (ParComp NodeInfo
_ Exp NodeInfo
e [[QualStmt NodeInfo]]
qstmts) = do
  let horVariant :: Printer ()
horVariant = Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
        [[QualStmt NodeInfo]]
-> ([QualStmt NodeInfo] -> Printer ()) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [[QualStmt NodeInfo]]
qstmts (([QualStmt NodeInfo] -> Printer ()) -> Printer ())
-> ([QualStmt NodeInfo] -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \[QualStmt NodeInfo]
qstmt -> do
          String -> Printer ()
write String
" | "
          [Printer ()] -> Printer ()
commas ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (QualStmt NodeInfo -> Printer ())
-> [QualStmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [QualStmt NodeInfo]
qstmt
      verVariant :: Printer ()
verVariant = do
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"[ ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
        Printer ()
newline
        [[QualStmt NodeInfo]]
-> ([QualStmt NodeInfo] -> Printer ()) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [[QualStmt NodeInfo]]
qstmts (([QualStmt NodeInfo] -> Printer ()) -> Printer ())
-> ([QualStmt NodeInfo] -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \[QualStmt NodeInfo]
qstmt -> do
          Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"| ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
", " ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (QualStmt NodeInfo -> Printer ())
-> [QualStmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map QualStmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [QualStmt NodeInfo]
qstmt
          Printer ()
newline
        String -> Printer ()
write String
"]"
  Printer ()
horVariant Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVariant

exp (TypeApp NodeInfo
_ Type NodeInfo
t) = do
  String -> Printer ()
write String
"@"
  Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
t
exp (NegApp NodeInfo
_ Exp NodeInfo
e) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"-")
         (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
exp (Lambda NodeInfo
_ [Pat NodeInfo]
ps Exp NodeInfo
e) = do
  String -> Printer ()
write String
"\\"
  [Printer ()] -> Printer ()
spaced [ do case (Int
i, Pat NodeInfo
x) of
                (Int
0, PIrrPat {}) -> Printer ()
space
                (Int
0, PBangPat {}) -> Printer ()
space
                (Int, Pat NodeInfo)
_ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
x
         | (Int
i, Pat NodeInfo
x) <- [Int] -> [Pat NodeInfo] -> [(Int, Pat NodeInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [Pat NodeInfo]
ps
         ]
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write String
" ->") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
exp (Paren NodeInfo
_ Exp NodeInfo
e) = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
exp (Case NodeInfo
_ Exp NodeInfo
e [Alt NodeInfo]
alts) =
  do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"case ")
            (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
                String -> Printer ()
write String
" of")
     if [Alt NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt NodeInfo]
alts
       then String -> Printer ()
write String
" {}"
       else do Printer ()
newline
               Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock ([Printer ()] -> Printer ()
lined ((Alt NodeInfo -> Printer ()) -> [Alt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Printer () -> Printer ()
forall a. Bool -> Printer a -> Printer a
withCaseContext Bool
True (Printer () -> Printer ())
-> (Alt NodeInfo -> Printer ()) -> Alt NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [Alt NodeInfo]
alts))
exp (Do NodeInfo
_ [Stmt NodeInfo]
stmts) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"do ")
         ([Printer ()] -> Printer ()
lined ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
stmts))
exp (MDo NodeInfo
_ [Stmt NodeInfo]
stmts) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"mdo ")
         ([Printer ()] -> Printer ()
lined ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
stmts))
exp (LeftSection NodeInfo
_ Exp NodeInfo
e QOp NodeInfo
op) =
  Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
                     Printer ()
space)
                 (QOp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QOp NodeInfo
op))
exp (RightSection NodeInfo
_ QOp NodeInfo
e Exp NodeInfo
op) =
  Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do QOp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QOp NodeInfo
e
                     Printer ()
space)
                 (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
op))
exp (EnumFrom NodeInfo
_ Exp NodeInfo
e) =
  Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
               String -> Printer ()
write String
" ..")
exp (EnumFromTo NodeInfo
_ Exp NodeInfo
e Exp NodeInfo
f) =
  Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
                       String -> Printer ()
write String
" .. ")
                   (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
f))
exp (EnumFromThen NodeInfo
_ Exp NodeInfo
e Exp NodeInfo
t) =
  Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
                       String -> Printer ()
write String
",")
                   (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
t
                       String -> Printer ()
write String
" .."))
exp (EnumFromThenTo NodeInfo
_ Exp NodeInfo
e Exp NodeInfo
t Exp NodeInfo
f) =
  Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
                       String -> Printer ()
write String
",")
                   (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
t
                               String -> Printer ()
write String
" .. ")
                           (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
f)))
exp (ExpTypeSig NodeInfo
_ Exp NodeInfo
e Type NodeInfo
t) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
             String -> Printer ()
write String
" :: ")
         (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
t)
exp (VarQuote NodeInfo
_ QName NodeInfo
x) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"'")
         (QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
x)
exp (TypQuote NodeInfo
_ QName NodeInfo
x) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"''")
         (QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
x)
exp (BracketExp NodeInfo
_ Bracket NodeInfo
b) = Bracket NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Bracket NodeInfo
b
exp (SpliceExp NodeInfo
_ Splice NodeInfo
s) = Splice NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Splice NodeInfo
s
exp (QuasiQuote NodeInfo
_ String
n String
s) = String -> Printer () -> Printer ()
quotation String
n (String -> Printer ()
string String
s)
exp (LCase NodeInfo
_ [Alt NodeInfo]
alts) =
  do String -> Printer ()
write String
"\\case"
     if [Alt NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt NodeInfo]
alts
       then String -> Printer ()
write String
" {}"
       else do Printer ()
newline
               Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock ([Printer ()] -> Printer ()
lined ((Alt NodeInfo -> Printer ()) -> [Alt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Printer () -> Printer ()
forall a. Bool -> Printer a -> Printer a
withCaseContext Bool
True (Printer () -> Printer ())
-> (Alt NodeInfo -> Printer ()) -> Alt NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [Alt NodeInfo]
alts))
exp (MultiIf NodeInfo
_ [GuardedRhs NodeInfo]
alts) =
  Bool -> Printer () -> Printer ()
forall a. Bool -> Printer a -> Printer a
withCaseContext
    Bool
True
    (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
       (String -> Printer ()
write String
"if ")
       ([Printer ()] -> Printer ()
lined
          ((GuardedRhs NodeInfo -> Printer ())
-> [GuardedRhs NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map
             (\GuardedRhs NodeInfo
p -> do
                String -> Printer ()
write String
"| "
                GuardedRhs NodeInfo -> Printer ()
prettyG GuardedRhs NodeInfo
p)
             [GuardedRhs NodeInfo]
alts)))
  where
    prettyG :: GuardedRhs NodeInfo -> Printer ()
prettyG (GuardedRhs NodeInfo
_ [Stmt NodeInfo]
stmts Exp NodeInfo
e) = do
      Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented
        Int64
1
        (do ([Printer ()] -> Printer ()
lined (((Int, Stmt NodeInfo) -> Printer ())
-> [(Int, Stmt NodeInfo)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map
                         (\(Int
i,Stmt NodeInfo
p) -> do
                            Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1)
                                   Printer ()
space
                            Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Stmt NodeInfo
p
                            Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Stmt NodeInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Stmt NodeInfo]
stmts)
                                   (String -> Printer ()
write String
","))
                         ([Int] -> [Stmt NodeInfo] -> [(Int, Stmt NodeInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Stmt NodeInfo]
stmts))))
      Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write String
" " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
rhsSeparator) (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
exp (Lit NodeInfo
_ Literal NodeInfo
lit) = Literal NodeInfo -> Printer ()
forall (ast :: * -> *). Pretty ast => ast NodeInfo -> Printer ()
prettyInternal Literal NodeInfo
lit
exp (Var NodeInfo
_ QName NodeInfo
q) = QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
q
exp (IPVar NodeInfo
_ IPName NodeInfo
q) = IPName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty IPName NodeInfo
q
exp (Con NodeInfo
_ QName NodeInfo
q) = QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
q

exp x :: Exp NodeInfo
x@XTag{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@XETag{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@XPcdata{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@XExpTag{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@XChildTag{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@CorePragma{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@SCCPragma{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@GenPragma{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@Proc{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@LeftArrApp{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@RightArrApp{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@LeftArrHighApp{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@RightArrHighApp{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@ParArray{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@ParArrayFromTo{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@ParArrayFromThenTo{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp x :: Exp NodeInfo
x@ParArrayComp{} = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Exp NodeInfo
x
exp (OverloadedLabel NodeInfo
_ String
label) = String -> Printer ()
string (Char
'#' Char -> String -> String
forall a. a -> [a] -> [a]
: String
label)

instance Pretty IPName where
 prettyInternal :: IPName NodeInfo -> Printer ()
prettyInternal = IPName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'

instance Pretty Stmt where
  prettyInternal :: Stmt NodeInfo -> Printer ()
prettyInternal =
    Stmt NodeInfo -> Printer ()
stmt

instance Pretty QualStmt where
  prettyInternal :: QualStmt NodeInfo -> Printer ()
prettyInternal QualStmt NodeInfo
x =
    case QualStmt NodeInfo
x of
      QualStmt NodeInfo
_ Stmt NodeInfo
s -> Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Stmt NodeInfo
s
      ThenTrans NodeInfo
_ Exp NodeInfo
s -> do
        String -> Printer ()
write String
"then "
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
      ThenBy NodeInfo
_ Exp NodeInfo
s Exp NodeInfo
t -> do
        String -> Printer ()
write String
"then "
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
        String -> Printer ()
write String
" by "
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
t
      GroupBy NodeInfo
_ Exp NodeInfo
s -> do
        String -> Printer ()
write String
"then group by "
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
      GroupUsing NodeInfo
_ Exp NodeInfo
s -> do
        String -> Printer ()
write String
"then group using "
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
      GroupByUsing NodeInfo
_ Exp NodeInfo
s Exp NodeInfo
t -> do
        String -> Printer ()
write String
"then group by "
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
        String -> Printer ()
write String
" using "
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
t

instance Pretty Decl where
  prettyInternal :: Decl NodeInfo -> Printer ()
prettyInternal = Decl NodeInfo -> Printer ()
decl'

-- | Render a declaration.
decl ::  Decl NodeInfo -> Printer ()
decl :: Decl NodeInfo -> Printer ()
decl (InstDecl NodeInfo
_ Maybe (Overlap NodeInfo)
moverlap InstRule NodeInfo
dhead Maybe [InstDecl NodeInfo]
decls) =
  do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"instance ")
            (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (Maybe (Overlap NodeInfo) -> Printer ()
maybeOverlap Maybe (Overlap NodeInfo)
moverlap)
                    (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (InstRule NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstRule NodeInfo
dhead)
                            (Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([InstDecl NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([InstDecl NodeInfo]
-> Maybe [InstDecl NodeInfo] -> [InstDecl NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [InstDecl NodeInfo]
decls))
                                    (String -> Printer ()
write String
" where"))))
     Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([InstDecl NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([InstDecl NodeInfo]
-> Maybe [InstDecl NodeInfo] -> [InstDecl NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [InstDecl NodeInfo]
decls))
            (do Printer ()
newline
                Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock ([Printer ()] -> Printer ()
lined ((InstDecl NodeInfo -> Printer ())
-> [InstDecl NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map InstDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ([InstDecl NodeInfo]
-> Maybe [InstDecl NodeInfo] -> [InstDecl NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [InstDecl NodeInfo]
decls))))
decl (SpliceDecl NodeInfo
_ Exp NodeInfo
e) = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
decl (TypeSig NodeInfo
_ [Name NodeInfo]
names Type NodeInfo
ty) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
", ")
                   ((Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Name NodeInfo]
names)
             String -> Printer ()
write String
" :: ")
         (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
decl (FunBind NodeInfo
_ [Match NodeInfo]
matches) =
  [Printer ()] -> Printer ()
lined ((Match NodeInfo -> Printer ()) -> [Match NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Match NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Match NodeInfo]
matches)
decl (ClassDecl NodeInfo
_ Maybe (Context NodeInfo)
ctx DeclHead NodeInfo
dhead [FunDep NodeInfo]
fundeps Maybe [ClassDecl NodeInfo]
decls) =
  do Maybe (Context NodeInfo)
-> DeclHead NodeInfo
-> [FunDep NodeInfo]
-> Maybe [ClassDecl NodeInfo]
-> Printer ()
classHead Maybe (Context NodeInfo)
ctx DeclHead NodeInfo
dhead [FunDep NodeInfo]
fundeps Maybe [ClassDecl NodeInfo]
decls
     Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ClassDecl NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ClassDecl NodeInfo]
-> Maybe [ClassDecl NodeInfo] -> [ClassDecl NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ClassDecl NodeInfo]
decls))
            (do Printer ()
newline
                Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock ([Printer ()] -> Printer ()
lined ((ClassDecl NodeInfo -> Printer ())
-> [ClassDecl NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ClassDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ([ClassDecl NodeInfo]
-> Maybe [ClassDecl NodeInfo] -> [ClassDecl NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ClassDecl NodeInfo]
decls))))
decl (TypeDecl NodeInfo
_ DeclHead NodeInfo
typehead Type NodeInfo
typ') = do
  String -> Printer ()
write String
"type "
  DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
typehead
  Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
ifFitsOnOneLineOrElse
    (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
" = ") (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
typ'))
    (do Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
" = ") (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
typ')))
decl (TypeFamDecl NodeInfo
_ DeclHead NodeInfo
declhead Maybe (ResultSig NodeInfo)
result Maybe (InjectivityInfo NodeInfo)
injectivity) = do
  String -> Printer ()
write String
"type family "
  DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
declhead
  case Maybe (ResultSig NodeInfo)
result of
    Just ResultSig NodeInfo
r -> do
      Printer ()
space
      let sep :: String
sep = case ResultSig NodeInfo
r of
                  KindSig NodeInfo
_ Type NodeInfo
_ -> String
"::"
                  TyVarSig NodeInfo
_ TyVarBind NodeInfo
_ -> String
"="
      String -> Printer ()
write String
sep
      Printer ()
space
      ResultSig NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ResultSig NodeInfo
r
    Maybe (ResultSig NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  case Maybe (InjectivityInfo NodeInfo)
injectivity of
    Just InjectivityInfo NodeInfo
i -> do
      Printer ()
space
      InjectivityInfo NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InjectivityInfo NodeInfo
i
    Maybe (InjectivityInfo NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
decl (ClosedTypeFamDecl NodeInfo
_ DeclHead NodeInfo
declhead Maybe (ResultSig NodeInfo)
result Maybe (InjectivityInfo NodeInfo)
injectivity [TypeEqn NodeInfo]
instances) = do
  String -> Printer ()
write String
"type family "
  DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
declhead
  Maybe (ResultSig NodeInfo)
-> (ResultSig NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (ResultSig NodeInfo)
result ((ResultSig NodeInfo -> Printer ()) -> Printer ())
-> (ResultSig NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \ResultSig NodeInfo
r -> do
    Printer ()
space
    let sep :: String
sep = case ResultSig NodeInfo
r of
                KindSig NodeInfo
_ Type NodeInfo
_ -> String
"::"
                TyVarSig NodeInfo
_ TyVarBind NodeInfo
_ -> String
"="
    String -> Printer ()
write String
sep
    Printer ()
space
    ResultSig NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ResultSig NodeInfo
r
  Maybe (InjectivityInfo NodeInfo)
-> (InjectivityInfo NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (InjectivityInfo NodeInfo)
injectivity ((InjectivityInfo NodeInfo -> Printer ()) -> Printer ())
-> (InjectivityInfo NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \InjectivityInfo NodeInfo
i -> do
    Printer ()
space
    InjectivityInfo NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InjectivityInfo NodeInfo
i
  Printer ()
space
  String -> Printer ()
write String
"where"
  Printer ()
newline
  Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock ([Printer ()] -> Printer ()
lined ((TypeEqn NodeInfo -> Printer ())
-> [TypeEqn NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map TypeEqn NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [TypeEqn NodeInfo]
instances))
decl (DataDecl NodeInfo
_ DataOrNew NodeInfo
dataornew Maybe (Context NodeInfo)
ctx DeclHead NodeInfo
dhead [QualConDecl NodeInfo]
condecls [Deriving NodeInfo]
mderivs) =
  do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do DataOrNew NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DataOrNew NodeInfo
dataornew
                Printer ()
space)
            (Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (Context NodeInfo)
ctx
                     (do DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
dhead
                         case [QualConDecl NodeInfo]
condecls of
                           [] -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                           [QualConDecl NodeInfo
x] -> QualConDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
singleCons QualConDecl NodeInfo
x
                           [QualConDecl NodeInfo]
xs -> [QualConDecl NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
[ast NodeInfo] -> Printer ()
multiCons [QualConDecl NodeInfo]
xs))
     Int64
indentSpaces <- Printer Int64
getIndentSpaces
     [Deriving NodeInfo]
-> (Deriving NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Deriving NodeInfo]
mderivs ((Deriving NodeInfo -> Printer ()) -> Printer ())
-> (Deriving NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \Deriving NodeInfo
deriv -> Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column Int64
indentSpaces (Deriving NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Deriving NodeInfo
deriv)
  where singleCons :: ast NodeInfo -> Printer ()
singleCons ast NodeInfo
x =
          do String -> Printer ()
write String
" ="
             Int64
indentSpaces <- Printer Int64
getIndentSpaces
             Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column Int64
indentSpaces
                    (do Printer ()
newline
                        ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ast NodeInfo
x)
        multiCons :: [ast NodeInfo] -> Printer ()
multiCons [ast NodeInfo]
xs =
          do Printer ()
newline
             Int64
indentSpaces <- Printer Int64
getIndentSpaces
             Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column Int64
indentSpaces
                    (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"=")
                            (String -> [Printer ()] -> Printer ()
prefixedLined String
"|"
                                           ((ast NodeInfo -> Printer ()) -> [ast NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (ast NodeInfo -> Printer ()) -> ast NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [ast NodeInfo]
xs)))

decl (GDataDecl NodeInfo
_ DataOrNew NodeInfo
dataornew Maybe (Context NodeInfo)
ctx DeclHead NodeInfo
dhead Maybe (Type NodeInfo)
mkind [GadtDecl NodeInfo]
condecls [Deriving NodeInfo]
mderivs) =
  do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (DataOrNew NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DataOrNew NodeInfo
dataornew Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space)
       (Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (Context NodeInfo)
ctx
         (do DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
dhead
             case Maybe (Type NodeInfo)
mkind of
               Maybe (Type NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
               Just Type NodeInfo
kind -> do String -> Printer ()
write String
" :: "
                               Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
             String -> Printer ()
write String
" where"))
     Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
       case [GadtDecl NodeInfo]
condecls of
         [] -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         [GadtDecl NodeInfo]
_ -> do
           Printer ()
newline
           [Printer ()] -> Printer ()
lined ((GadtDecl NodeInfo -> Printer ())
-> [GadtDecl NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map GadtDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [GadtDecl NodeInfo]
condecls)
       [Deriving NodeInfo]
-> (Deriving NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Deriving NodeInfo]
mderivs ((Deriving NodeInfo -> Printer ()) -> Printer ())
-> (Deriving NodeInfo -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \Deriving NodeInfo
deriv -> Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Deriving NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Deriving NodeInfo
deriv

decl (InlineSig NodeInfo
_ Bool
inline Maybe (Activation NodeInfo)
active QName NodeInfo
name) = do
  String -> Printer ()
write String
"{-# "

  Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
inline (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
write String
"NO"
  String -> Printer ()
write String
"INLINE "
  case Maybe (Activation NodeInfo)
active of
    Maybe (Activation NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (ActiveFrom NodeInfo
_ Int
x) -> String -> Printer ()
write (String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] ")
    Just (ActiveUntil NodeInfo
_ Int
x) -> String -> Printer ()
write (String
"[~" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] ")
  QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
name

  String -> Printer ()
write String
" #-}"
decl (MinimalPragma NodeInfo
_ (Just BooleanFormula NodeInfo
formula)) =
  String -> String -> Printer () -> Printer ()
forall a. String -> String -> Printer a -> Printer a
wrap String
"{-# " String
" #-}" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
    Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"MINIMAL ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ BooleanFormula NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty BooleanFormula NodeInfo
formula
decl (ForImp NodeInfo
_ CallConv NodeInfo
callconv Maybe (Safety NodeInfo)
maybeSafety Maybe String
maybeName Name NodeInfo
name Type NodeInfo
ty) = do
  String -> Printer ()
string String
"foreign import "
  CallConv NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' CallConv NodeInfo
callconv Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
  case Maybe (Safety NodeInfo)
maybeSafety of
    Just Safety NodeInfo
safety -> Safety NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Safety NodeInfo
safety Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
    Maybe (Safety NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  case Maybe String
maybeName of
    Just String
namestr -> String -> Printer ()
string (String -> String
forall a. Show a => a -> String
show String
namestr) Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
    Maybe String
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Name NodeInfo
name
  Maybe PrintState
tyline <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer () -> Printer (Maybe PrintState))
-> Printer () -> Printer (Maybe PrintState)
forall a b. (a -> b) -> a -> b
$ do String -> Printer ()
string String
" :: "
                               Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
  case Maybe PrintState
tyline of
    Just PrintState
line -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
line
    Maybe PrintState
Nothing -> do Printer ()
newline
                  Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do String -> Printer ()
string String
":: "
                                     Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
decl (ForExp NodeInfo
_ CallConv NodeInfo
callconv Maybe String
maybeName Name NodeInfo
name Type NodeInfo
ty) = do
  String -> Printer ()
string String
"foreign export "
  CallConv NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' CallConv NodeInfo
callconv Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
  case Maybe String
maybeName of
    Just String
namestr -> String -> Printer ()
string (String -> String
forall a. Show a => a -> String
show String
namestr) Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
    Maybe String
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Name NodeInfo
name
  Maybe PrintState
tyline <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer () -> Printer (Maybe PrintState))
-> Printer () -> Printer (Maybe PrintState)
forall a b. (a -> b) -> a -> b
$ do String -> Printer ()
string String
" :: "
                               Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
  case Maybe PrintState
tyline of
    Just PrintState
line -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
line
    Maybe PrintState
Nothing -> do Printer ()
newline
                  Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do String -> Printer ()
string String
":: "
                                     Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
decl Decl NodeInfo
x' = Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Decl NodeInfo
x'

classHead
  :: Maybe (Context NodeInfo)
  -> DeclHead NodeInfo
  -> [FunDep NodeInfo]
  -> Maybe [ClassDecl NodeInfo]
  -> Printer ()
classHead :: Maybe (Context NodeInfo)
-> DeclHead NodeInfo
-> [FunDep NodeInfo]
-> Maybe [ClassDecl NodeInfo]
-> Printer ()
classHead Maybe (Context NodeInfo)
ctx DeclHead NodeInfo
dhead [FunDep NodeInfo]
fundeps Maybe [ClassDecl NodeInfo]
decls = Printer ()
shortHead Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
longHead
  where
    shortHead :: Printer ()
shortHead =
      Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
        (String -> Printer ()
write String
"class ")
        (Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (Context NodeInfo)
ctx (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
         Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
           (DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
dhead)
           (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FunDep NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FunDep NodeInfo]
fundeps) (String -> Printer ()
write String
" | " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Printer ()] -> Printer ()
commas ((FunDep NodeInfo -> Printer ())
-> [FunDep NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map FunDep NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [FunDep NodeInfo]
fundeps)))
              (Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ClassDecl NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ClassDecl NodeInfo]
-> Maybe [ClassDecl NodeInfo] -> [ClassDecl NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ClassDecl NodeInfo]
decls)) (String -> Printer ()
write String
" where"))))
    longHead :: Printer ()
longHead = do
      Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"class ") (Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (Context NodeInfo)
ctx (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
dhead)
      Printer ()
newline
      Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
        Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FunDep NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FunDep NodeInfo]
fundeps) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
          Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"| ") (String -> [Printer ()] -> Printer ()
prefixedLined String
", " ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (FunDep NodeInfo -> Printer ())
-> [FunDep NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map FunDep NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [FunDep NodeInfo]
fundeps)
          Printer ()
newline
        Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ClassDecl NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ClassDecl NodeInfo]
-> Maybe [ClassDecl NodeInfo] -> [ClassDecl NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ClassDecl NodeInfo]
decls)) (String -> Printer ()
write String
"where")

instance Pretty TypeEqn where
  prettyInternal :: TypeEqn NodeInfo -> Printer ()
prettyInternal (TypeEqn NodeInfo
_ Type NodeInfo
in_ Type NodeInfo
out_) = do
    Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
in_
    String -> Printer ()
write String
" = "
    Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
out_

instance Pretty Deriving where
  prettyInternal :: Deriving NodeInfo -> Printer ()
prettyInternal (Deriving NodeInfo
_ Maybe (DerivStrategy NodeInfo)
strategy [InstRule NodeInfo]
heads) =
    Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"deriving" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
writeStrategy) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
      let heads' :: [InstRule NodeInfo]
heads' =
            if [InstRule NodeInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [InstRule NodeInfo]
heads Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
              then (InstRule NodeInfo -> InstRule NodeInfo)
-> [InstRule NodeInfo] -> [InstRule NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map InstRule NodeInfo -> InstRule NodeInfo
forall l. InstRule l -> InstRule l
stripParens [InstRule NodeInfo]
heads
              else [InstRule NodeInfo]
heads
      Maybe PrintState
maybeDerives <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer () -> Printer (Maybe PrintState))
-> Printer () -> Printer (Maybe PrintState)
forall a b. (a -> b) -> a -> b
$ Printer () -> Printer ()
forall a. Printer a -> Printer a
parens ([Printer ()] -> Printer ()
commas ((InstRule NodeInfo -> Printer ())
-> [InstRule NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map InstRule NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [InstRule NodeInfo]
heads'))
      case Maybe PrintState
maybeDerives of
        Maybe PrintState
Nothing -> [InstRule NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
[ast NodeInfo] -> Printer ()
formatMultiLine [InstRule NodeInfo]
heads'
        Just PrintState
derives -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
derives
    where
      writeStrategy :: Printer ()
writeStrategy = case Maybe (DerivStrategy NodeInfo)
strategy of
        Maybe (DerivStrategy NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just DerivStrategy NodeInfo
st -> DerivStrategy NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DerivStrategy NodeInfo
st Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
      stripParens :: InstRule l -> InstRule l
stripParens (IParen l
_ InstRule l
iRule) = InstRule l -> InstRule l
stripParens InstRule l
iRule
      stripParens InstRule l
x = InstRule l
x
      formatMultiLine :: [ast NodeInfo] -> Printer ()
formatMultiLine [ast NodeInfo]
derives = do
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"( ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
", " ((ast NodeInfo -> Printer ()) -> [ast NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [ast NodeInfo]
derives)
        Printer ()
newline
        String -> Printer ()
write String
")"

instance Pretty DerivStrategy where
  prettyInternal :: DerivStrategy NodeInfo -> Printer ()
prettyInternal DerivStrategy NodeInfo
x =
    case DerivStrategy NodeInfo
x of
      DerivStock NodeInfo
_ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      DerivAnyclass NodeInfo
_ -> String -> Printer ()
write String
"anyclass"
      DerivNewtype NodeInfo
_ -> String -> Printer ()
write String
"newtype"

instance Pretty Alt where
  prettyInternal :: Alt NodeInfo -> Printer ()
prettyInternal Alt NodeInfo
x =
    case Alt NodeInfo
x of
      Alt NodeInfo
_ Pat NodeInfo
p Rhs NodeInfo
galts Maybe (Binds NodeInfo)
mbinds ->
        do Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p
           Rhs NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Rhs NodeInfo
galts
           case Maybe (Binds NodeInfo)
mbinds of
             Maybe (Binds NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             Just Binds NodeInfo
binds ->
               do Printer ()
newline
                  Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"where ")
                                (Binds NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Binds NodeInfo
binds))

instance Pretty Asst where
  prettyInternal :: Asst NodeInfo -> Printer ()
prettyInternal Asst NodeInfo
x =
    case Asst NodeInfo
x of
      IParam NodeInfo
_ IPName NodeInfo
name Type NodeInfo
ty -> do
        IPName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty IPName NodeInfo
name
        String -> Printer ()
write String
" :: "
        Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
      ParenA NodeInfo
_ Asst NodeInfo
asst -> Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Asst NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Asst NodeInfo
asst)
#if MIN_VERSION_haskell_src_exts(1,21,0)
      TypeA NodeInfo
_ Type NodeInfo
ty -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
#else
      ClassA _ name types -> spaced (pretty name : map pretty types)
      i@InfixA {} -> pretty' i
      EqualP _ a b -> do
        pretty a
        write " ~ "
        pretty b
      AppA _ name tys ->
        spaced (pretty name : map pretty tys)
      WildCardA _ name ->
        case name of
          Nothing -> write "_"
          Just n -> do
            write "_"
            pretty n
#endif

instance Pretty BangType where
  prettyInternal :: BangType NodeInfo -> Printer ()
prettyInternal BangType NodeInfo
x =
    case BangType NodeInfo
x of
      BangedTy NodeInfo
_ -> String -> Printer ()
write String
"!"
      LazyTy NodeInfo
_ -> String -> Printer ()
write String
"~"
      NoStrictAnnot NodeInfo
_ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Pretty Unpackedness where
  prettyInternal :: Unpackedness NodeInfo -> Printer ()
prettyInternal (Unpack NodeInfo
_) = String -> Printer ()
write String
"{-# UNPACK #-}"
  prettyInternal (NoUnpack NodeInfo
_) = String -> Printer ()
write String
"{-# NOUNPACK #-}"
  prettyInternal (NoUnpackPragma NodeInfo
_) = () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Pretty Binds where
  prettyInternal :: Binds NodeInfo -> Printer ()
prettyInternal Binds NodeInfo
x =
    case Binds NodeInfo
x of
      BDecls NodeInfo
_ [Decl NodeInfo]
ds -> [Printer ()] -> Printer ()
lined ((Decl NodeInfo -> Printer ()) -> [Decl NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Decl NodeInfo]
ds)
      IPBinds NodeInfo
_ [IPBind NodeInfo]
i -> [Printer ()] -> Printer ()
lined ((IPBind NodeInfo -> Printer ())
-> [IPBind NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map IPBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [IPBind NodeInfo]
i)

instance Pretty ClassDecl where
  prettyInternal :: ClassDecl NodeInfo -> Printer ()
prettyInternal ClassDecl NodeInfo
x =
    case ClassDecl NodeInfo
x of
      ClsDecl NodeInfo
_ Decl NodeInfo
d -> Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
d
      ClsDataFam NodeInfo
_ Maybe (Context NodeInfo)
ctx DeclHead NodeInfo
h Maybe (ResultSig NodeInfo)
mkind ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
          (String -> Printer ()
write String
"data ")
          (Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx
             Maybe (Context NodeInfo)
ctx
             (do DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
h
                 (case Maybe (ResultSig NodeInfo)
mkind of
                    Maybe (ResultSig NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    Just ResultSig NodeInfo
kind -> do
                      String -> Printer ()
write String
" :: "
                      ResultSig NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ResultSig NodeInfo
kind)))
      ClsTyFam NodeInfo
_ DeclHead NodeInfo
h Maybe (ResultSig NodeInfo)
msig Maybe (InjectivityInfo NodeInfo)
minj ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
          (String -> Printer ()
write String
"type ")
          (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
             (DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
h)
             (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
                ((ResultSig NodeInfo -> Printer ())
-> Maybe (ResultSig NodeInfo) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
                   (\case
                      KindSig NodeInfo
_ Type NodeInfo
kind -> String -> Printer ()
write String
" :: " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
                      TyVarSig NodeInfo
_ TyVarBind NodeInfo
tyVarBind -> String -> Printer ()
write String
" = " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty TyVarBind NodeInfo
tyVarBind)
                   Maybe (ResultSig NodeInfo)
msig)
                ((InjectivityInfo NodeInfo -> Printer ())
-> Maybe (InjectivityInfo NodeInfo) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\InjectivityInfo NodeInfo
inj -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InjectivityInfo NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InjectivityInfo NodeInfo
inj) Maybe (InjectivityInfo NodeInfo)
minj)))
      ClsTyDef NodeInfo
_ (TypeEqn NodeInfo
_ Type NodeInfo
this Type NodeInfo
that) -> do
        String -> Printer ()
write String
"type "
        Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
this
        String -> Printer ()
write String
" = "
        Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
that
      ClsDefSig NodeInfo
_ Name NodeInfo
name Type NodeInfo
ty -> do
        String -> Printer ()
write String
"default "
        Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
        String -> Printer ()
write String
" :: "
        Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty

instance Pretty ConDecl where
  prettyInternal :: ConDecl NodeInfo -> Printer ()
prettyInternal ConDecl NodeInfo
x =
    ConDecl NodeInfo -> Printer ()
conDecl ConDecl NodeInfo
x

instance Pretty FieldDecl where
  prettyInternal :: FieldDecl NodeInfo -> Printer ()
prettyInternal (FieldDecl NodeInfo
_ [Name NodeInfo]
names Type NodeInfo
ty) =
    Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do [Printer ()] -> Printer ()
commas ((Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Name NodeInfo]
names)
               String -> Printer ()
write String
" :: ")
           (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)

instance Pretty FieldUpdate where
  prettyInternal :: FieldUpdate NodeInfo -> Printer ()
prettyInternal FieldUpdate NodeInfo
x =
    case FieldUpdate NodeInfo
x of
      FieldUpdate NodeInfo
_ QName NodeInfo
n Exp NodeInfo
e ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (do QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
n
                  String -> Printer ()
write String
" =")
               (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
      FieldPun NodeInfo
_ QName NodeInfo
n -> QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
n
      FieldWildcard NodeInfo
_ -> String -> Printer ()
write String
".."

instance Pretty GuardedRhs where
  prettyInternal :: GuardedRhs NodeInfo -> Printer ()
prettyInternal  =
    GuardedRhs NodeInfo -> Printer ()
guardedRhs

instance Pretty InjectivityInfo where
  prettyInternal :: InjectivityInfo NodeInfo -> Printer ()
prettyInternal InjectivityInfo NodeInfo
x = InjectivityInfo NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' InjectivityInfo NodeInfo
x

instance Pretty InstDecl where
  prettyInternal :: InstDecl NodeInfo -> Printer ()
prettyInternal InstDecl NodeInfo
i =
    case InstDecl NodeInfo
i of
      InsDecl NodeInfo
_ Decl NodeInfo
d -> Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
d
      InsType NodeInfo
_ Type NodeInfo
name Type NodeInfo
ty ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do String -> Printer ()
write String
"type "
                   Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
name
                   String -> Printer ()
write String
" = ")
               (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
      InstDecl NodeInfo
_ -> InstDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' InstDecl NodeInfo
i

instance Pretty Match where
  prettyInternal :: Match NodeInfo -> Printer ()
prettyInternal = Match NodeInfo -> Printer ()
match
    {-case x of
      Match _ name pats rhs' mbinds ->
        do depend (do pretty name
                      space)
                  (spaced (map pretty pats))
           withCaseContext False (pretty rhs')
           case mbinds of
             Nothing -> return ()
             Just binds ->
               do newline
                  indentedBlock (depend (write "where ")
                                        (pretty binds))
      InfixMatch _ pat1 name pats rhs' mbinds ->
        do depend (do pretty pat1
                      space
                      prettyInfixName name)
                  (do space
                      spaced (map pretty pats))
           withCaseContext False (pretty rhs')
           case mbinds of
             Nothing -> return ()
             Just binds ->
               do newline
                  indentedBlock (depend (write "where ")
                                        (pretty binds))-}

instance Pretty PatField where
  prettyInternal :: PatField NodeInfo -> Printer ()
prettyInternal PatField NodeInfo
x =
    case PatField NodeInfo
x of
      PFieldPat NodeInfo
_ QName NodeInfo
n Pat NodeInfo
p ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
n
                   String -> Printer ()
write String
" = ")
               (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
      PFieldPun NodeInfo
_ QName NodeInfo
n -> QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
n
      PFieldWildcard NodeInfo
_ -> String -> Printer ()
write String
".."

instance Pretty QualConDecl where
  prettyInternal :: QualConDecl NodeInfo -> Printer ()
prettyInternal QualConDecl NodeInfo
x =
    case QualConDecl NodeInfo
x of
      QualConDecl NodeInfo
_ Maybe [TyVarBind NodeInfo]
tyvars Maybe (Context NodeInfo)
ctx ConDecl NodeInfo
d ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([TyVarBind NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TyVarBind NodeInfo]
-> Maybe [TyVarBind NodeInfo] -> [TyVarBind NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [TyVarBind NodeInfo]
tyvars))
                       (do String -> Printer ()
write String
"forall "
                           [Printer ()] -> Printer ()
spaced ((TyVarBind NodeInfo -> Printer ())
-> [TyVarBind NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ([TyVarBind NodeInfo] -> [TyVarBind NodeInfo]
forall a. [a] -> [a]
reverse ([TyVarBind NodeInfo]
-> Maybe [TyVarBind NodeInfo] -> [TyVarBind NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [TyVarBind NodeInfo]
tyvars)))
                           String -> Printer ()
write String
". "))
               (Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (Context NodeInfo)
ctx
                       (ConDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ConDecl NodeInfo
d))

instance Pretty GadtDecl where
#if MIN_VERSION_haskell_src_exts(1,21,0)
  prettyInternal :: GadtDecl NodeInfo -> Printer ()
prettyInternal (GadtDecl NodeInfo
_ Name NodeInfo
name Maybe [TyVarBind NodeInfo]
_ Maybe (Context NodeInfo)
_ Maybe [FieldDecl NodeInfo]
fields Type NodeInfo
t) =
#else
  prettyInternal (GadtDecl _ name fields t) =
#endif
    Printer ()
horVar Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVar
    where
      fields' :: Printer () -> Printer ()
fields' Printer ()
p =
        case [FieldDecl NodeInfo]
-> Maybe [FieldDecl NodeInfo] -> [FieldDecl NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [FieldDecl NodeInfo]
fields of
          [] -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          [FieldDecl NodeInfo]
fs -> do
            Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"{") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
              String -> [Printer ()] -> Printer ()
prefixedLined String
"," ((FieldDecl NodeInfo -> Printer ())
-> [FieldDecl NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (FieldDecl NodeInfo -> Printer ())
-> FieldDecl NodeInfo
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [FieldDecl NodeInfo]
fs)
            String -> Printer ()
write String
"}"
            Printer ()
p
      horVar :: Printer ()
horVar =
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
write String
" :: ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
          Printer () -> Printer ()
fields' (String -> Printer ()
write String
" -> ")
          Type NodeInfo -> Printer ()
declTy Type NodeInfo
t
      verVar :: Printer ()
verVar = do
        Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
        Printer ()
newline
        Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
          Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
":: ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
            Printer () -> Printer ()
fields' (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
              Printer ()
newline
              Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented (-Int64
3) (String -> Printer ()
write String
"-> ")
            Type NodeInfo -> Printer ()
declTy Type NodeInfo
t

instance Pretty Rhs where
  prettyInternal :: Rhs NodeInfo -> Printer ()
prettyInternal =
    Rhs NodeInfo -> Printer ()
rhs

instance Pretty Splice where
  prettyInternal :: Splice NodeInfo -> Printer ()
prettyInternal Splice NodeInfo
x =
    case Splice NodeInfo
x of
      IdSplice NodeInfo
_ String
str ->
        do String -> Printer ()
write String
"$"
           String -> Printer ()
string String
str
      ParenSplice NodeInfo
_ Exp NodeInfo
e ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"$")
               (Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e))

instance Pretty InstRule where
  prettyInternal :: InstRule NodeInfo -> Printer ()
prettyInternal (IParen NodeInfo
_ InstRule NodeInfo
rule) = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ InstRule NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstRule NodeInfo
rule
  prettyInternal (IRule NodeInfo
_ Maybe [TyVarBind NodeInfo]
mvarbinds Maybe (Context NodeInfo)
mctx InstHead NodeInfo
ihead) =
    do case Maybe [TyVarBind NodeInfo]
mvarbinds of
         Maybe [TyVarBind NodeInfo]
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         Just [TyVarBind NodeInfo]
xs -> do String -> Printer ()
write String
"forall "
                       [Printer ()] -> Printer ()
spaced ((TyVarBind NodeInfo -> Printer ())
-> [TyVarBind NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [TyVarBind NodeInfo]
xs)
                       String -> Printer ()
write String
". "
       case Maybe (Context NodeInfo)
mctx of
         Maybe (Context NodeInfo)
Nothing -> InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
ihead
         Just Context NodeInfo
ctx -> do
           Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (do Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Context NodeInfo
ctx
                                    String -> Printer ()
write String
" => "
                                    InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
ihead
                                    String -> Printer ()
write String
" where")
           case Maybe PrintState
mst of
             Maybe PrintState
Nothing -> Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (Context NodeInfo)
mctx (InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
ihead)
             Just {} -> do
               Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Context NodeInfo
ctx
               String -> Printer ()
write String
" => "
               InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
ihead

instance Pretty InstHead where
  prettyInternal :: InstHead NodeInfo -> Printer ()
prettyInternal InstHead NodeInfo
x =
    case InstHead NodeInfo
x of
      -- Base cases
      IHCon NodeInfo
_ QName NodeInfo
name -> QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
name
      IHInfix NodeInfo
_ Type NodeInfo
typ' QName NodeInfo
name ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
typ')
               (do Printer ()
space
                   QName NodeInfo -> Printer ()
prettyInfixOp QName NodeInfo
name)
      -- Recursive application
      IHApp NodeInfo
_ InstHead NodeInfo
ihead Type NodeInfo
typ' ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
ihead)
               (do Printer ()
space
                   Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
typ')
      -- Wrapping in parens
      IHParen NodeInfo
_ InstHead NodeInfo
h -> Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
h)

instance Pretty DeclHead where
  prettyInternal :: DeclHead NodeInfo -> Printer ()
prettyInternal DeclHead NodeInfo
x =
    case DeclHead NodeInfo
x of
      DHead NodeInfo
_ Name NodeInfo
name -> Name NodeInfo -> Printer ()
prettyQuoteName Name NodeInfo
name
      DHParen NodeInfo
_ DeclHead NodeInfo
h -> Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
h)
      DHInfix NodeInfo
_ TyVarBind NodeInfo
var Name NodeInfo
name ->
        do TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty TyVarBind NodeInfo
var
           Printer ()
space
           Name NodeInfo -> Printer ()
prettyInfixName Name NodeInfo
name
      DHApp NodeInfo
_ DeclHead NodeInfo
dhead TyVarBind NodeInfo
var ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (DeclHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DeclHead NodeInfo
dhead)
               (do Printer ()
space
                   TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty TyVarBind NodeInfo
var)

instance Pretty Overlap where
  prettyInternal :: Overlap NodeInfo -> Printer ()
prettyInternal (Overlap NodeInfo
_) = String -> Printer ()
write String
"{-# OVERLAP #-}"
  prettyInternal (Overlapping NodeInfo
_) = String -> Printer ()
write String
"{-# OVERLAPPING #-}"
  prettyInternal (Overlaps NodeInfo
_) = String -> Printer ()
write String
"{-# OVERLAPS #-}"
  prettyInternal (Overlappable NodeInfo
_) = String -> Printer ()
write String
"{-# OVERLAPPABLE #-}"
  prettyInternal (NoOverlap NodeInfo
_) = String -> Printer ()
write String
"{-# NO_OVERLAP #-}"
  prettyInternal (Incoherent NodeInfo
_) = String -> Printer ()
write String
"{-# INCOHERENT #-}"

instance Pretty Sign where
  prettyInternal :: Sign NodeInfo -> Printer ()
prettyInternal (Signless NodeInfo
_) = () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  prettyInternal (Negative NodeInfo
_) = String -> Printer ()
write String
"-"

instance Pretty CallConv where
  prettyInternal :: CallConv NodeInfo -> Printer ()
prettyInternal = CallConv NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'

instance Pretty Safety where
  prettyInternal :: Safety NodeInfo -> Printer ()
prettyInternal = Safety NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'

--------------------------------------------------------------------------------
-- * Unimplemented or incomplete printers

instance Pretty Module where
  prettyInternal :: Module NodeInfo -> Printer ()
prettyInternal Module NodeInfo
x =
    case Module NodeInfo
x of
      Module NodeInfo
_ Maybe (ModuleHead NodeInfo)
mayModHead [ModulePragma NodeInfo]
pragmas [ImportDecl NodeInfo]
imps [Decl NodeInfo]
decls ->
        do Printer () -> [Printer ()] -> Printer ()
inter (do Printer ()
newline
                     Printer ()
newline)
                 (((Bool, Printer ()) -> Maybe (Printer ()))
-> [(Bool, Printer ())] -> [Printer ()]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Bool
isNull,Printer ()
r) ->
                              if Bool
isNull
                                 then Maybe (Printer ())
forall a. Maybe a
Nothing
                                 else Printer () -> Maybe (Printer ())
forall a. a -> Maybe a
Just Printer ()
r)
                           [([ModulePragma NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModulePragma NodeInfo]
pragmas,Printer () -> [Printer ()] -> Printer ()
inter Printer ()
newline ((ModulePragma NodeInfo -> Printer ())
-> [ModulePragma NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ModulePragma NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [ModulePragma NodeInfo]
pragmas))
                           ,(case Maybe (ModuleHead NodeInfo)
mayModHead of
                               Maybe (ModuleHead NodeInfo)
Nothing -> (Bool
True,() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                               Just ModuleHead NodeInfo
modHead -> (Bool
False,ModuleHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleHead NodeInfo
modHead))
                           ,([ImportDecl NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ImportDecl NodeInfo]
imps,[ImportDecl NodeInfo] -> Printer ()
formatImports [ImportDecl NodeInfo]
imps)
                           ,([Decl NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Decl NodeInfo]
decls
                            ,Printer () -> [(Int, Printer ())] -> Printer ()
forall (m :: * -> *) a. Monad m => m a -> [(Int, m ())] -> m ()
interOf Printer ()
newline
                                     ((Decl NodeInfo -> (Int, Printer ()))
-> [Decl NodeInfo] -> [(Int, Printer ())]
forall a b. (a -> b) -> [a] -> [b]
map (\case
                                             r :: Decl NodeInfo
r@TypeSig{} -> (Int
1,Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
r)
                                             r :: Decl NodeInfo
r@InlineSig{} -> (Int
1, Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
r)
                                             Decl NodeInfo
r -> (Int
2,Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
r))
                                          [Decl NodeInfo]
decls))])
           Printer ()
newline
        where interOf :: m a -> [(Int, m ())] -> m ()
interOf m a
i ((Int
c,m ()
p):[(Int, m ())]
ps) =
                case [(Int, m ())]
ps of
                  [] -> m ()
p
                  [(Int, m ())]
_ ->
                    do m ()
p
                       Int -> m a -> m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
c m a
i
                       m a -> [(Int, m ())] -> m ()
interOf m a
i [(Int, m ())]
ps
              interOf m a
_ [] = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      XmlPage{} -> String -> Printer ()
forall a. HasCallStack => String -> a
error String
"FIXME: No implementation for XmlPage."
      XmlHybrid{} -> String -> Printer ()
forall a. HasCallStack => String -> a
error String
"FIXME: No implementation for XmlHybrid."

-- | Format imports, preserving empty newlines between groups.
formatImports :: [ImportDecl NodeInfo] -> Printer ()
formatImports :: [ImportDecl NodeInfo] -> Printer ()
formatImports =
  [Printer ()] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Printer ()] -> Printer ())
-> ([ImportDecl NodeInfo] -> [Printer ()])
-> [ImportDecl NodeInfo]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
intersperse (Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
newline) ([Printer ()] -> [Printer ()])
-> ([ImportDecl NodeInfo] -> [Printer ()])
-> [ImportDecl NodeInfo]
-> [Printer ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ([ImportDecl NodeInfo] -> Printer ())
-> [[ImportDecl NodeInfo]] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map [ImportDecl NodeInfo] -> Printer ()
formatImportGroup ([[ImportDecl NodeInfo]] -> [Printer ()])
-> ([ImportDecl NodeInfo] -> [[ImportDecl NodeInfo]])
-> [ImportDecl NodeInfo]
-> [Printer ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImportDecl NodeInfo -> ImportDecl NodeInfo -> Bool)
-> [ImportDecl NodeInfo] -> [[ImportDecl NodeInfo]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupAdjacentBy ImportDecl NodeInfo -> ImportDecl NodeInfo -> Bool
forall (ast :: * -> *) (ast :: * -> *).
(Annotated ast, Annotated ast) =>
ast NodeInfo -> ast NodeInfo -> Bool
atNextLine
  where
    atNextLine :: ast NodeInfo -> ast NodeInfo -> Bool
atNextLine ast NodeInfo
import1 ast NodeInfo
import2 =
      let end1 :: Int
end1 = SrcSpan -> Int
srcSpanEndLine (SrcSpanInfo -> SrcSpan
srcInfoSpan (NodeInfo -> SrcSpanInfo
nodeInfoSpan (ast NodeInfo -> NodeInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann ast NodeInfo
import1)))
          start2 :: Int
start2 = SrcSpan -> Int
srcSpanStartLine (SrcSpanInfo -> SrcSpan
srcInfoSpan (NodeInfo -> SrcSpanInfo
nodeInfoSpan (ast NodeInfo -> NodeInfo
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann ast NodeInfo
import2)))
      in Int
start2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
end1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
    formatImportGroup :: [ImportDecl NodeInfo] -> Printer ()
formatImportGroup [ImportDecl NodeInfo]
imps = do
      Bool
shouldSortImports <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((PrintState -> Bool) -> Printer Bool)
-> (PrintState -> Bool) -> Printer Bool
forall a b. (a -> b) -> a -> b
$ Config -> Bool
configSortImports (Config -> Bool) -> (PrintState -> Config) -> PrintState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintState -> Config
psConfig
      let imps1 :: [ImportDecl NodeInfo]
imps1 =
            if Bool
shouldSortImports
              then [ImportDecl NodeInfo] -> [ImportDecl NodeInfo]
forall l. [ImportDecl l] -> [ImportDecl l]
sortImports [ImportDecl NodeInfo]
imps
              else [ImportDecl NodeInfo]
imps
      [Printer ()] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Printer ()] -> Printer ())
-> ([Printer ()] -> [Printer ()]) -> [Printer ()] -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
intersperse Printer ()
newline ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (ImportDecl NodeInfo -> Printer ())
-> [ImportDecl NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl NodeInfo -> Printer ()
formatImport [ImportDecl NodeInfo]
imps1
    moduleVisibleName :: ImportDecl l -> String
moduleVisibleName ImportDecl l
idecl =
      let ModuleName l
_ String
name = ImportDecl l -> ModuleName l
forall l. ImportDecl l -> ModuleName l
importModule ImportDecl l
idecl
      in String
name
    formatImport :: ImportDecl NodeInfo -> Printer ()
formatImport = ImportDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty
    sortImports :: [ImportDecl l] -> [ImportDecl l]
sortImports [ImportDecl l]
imps = (ImportDecl l -> String) -> [ImportDecl l] -> [ImportDecl l]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ImportDecl l -> String
forall l. ImportDecl l -> String
moduleVisibleName ([ImportDecl l] -> [ImportDecl l])
-> ([ImportDecl l] -> [ImportDecl l])
-> [ImportDecl l]
-> [ImportDecl l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImportDecl l -> ImportDecl l) -> [ImportDecl l] -> [ImportDecl l]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl l -> ImportDecl l
forall l. ImportDecl l -> ImportDecl l
sortImportSpecsOnImport ([ImportDecl l] -> [ImportDecl l])
-> [ImportDecl l] -> [ImportDecl l]
forall a b. (a -> b) -> a -> b
$ [ImportDecl l]
imps
    sortImportSpecsOnImport :: ImportDecl l -> ImportDecl l
sortImportSpecsOnImport ImportDecl l
imp = ImportDecl l
imp { importSpecs :: Maybe (ImportSpecList l)
importSpecs = (ImportSpecList l -> ImportSpecList l)
-> Maybe (ImportSpecList l) -> Maybe (ImportSpecList l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ImportSpecList l -> ImportSpecList l
forall l. ImportSpecList l -> ImportSpecList l
sortImportSpecs (ImportDecl l -> Maybe (ImportSpecList l)
forall l. ImportDecl l -> Maybe (ImportSpecList l)
importSpecs ImportDecl l
imp) }
    sortImportSpecs :: ImportSpecList l -> ImportSpecList l
sortImportSpecs (ImportSpecList l
l Bool
hiding [ImportSpec l]
specs) = l -> Bool -> [ImportSpec l] -> ImportSpecList l
forall l. l -> Bool -> [ImportSpec l] -> ImportSpecList l
ImportSpecList l
l Bool
hiding [ImportSpec l]
sortedSpecs
      where
        sortedSpecs :: [ImportSpec l]
sortedSpecs = (ImportSpec l -> ImportSpec l -> Ordering)
-> [ImportSpec l] -> [ImportSpec l]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ImportSpec l -> ImportSpec l -> Ordering
forall l. ImportSpec l -> ImportSpec l -> Ordering
importSpecCompare ([ImportSpec l] -> [ImportSpec l])
-> ([ImportSpec l] -> [ImportSpec l])
-> [ImportSpec l]
-> [ImportSpec l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImportSpec l -> ImportSpec l) -> [ImportSpec l] -> [ImportSpec l]
forall a b. (a -> b) -> [a] -> [b]
map ImportSpec l -> ImportSpec l
forall l. ImportSpec l -> ImportSpec l
sortCNames ([ImportSpec l] -> [ImportSpec l])
-> [ImportSpec l] -> [ImportSpec l]
forall a b. (a -> b) -> a -> b
$ [ImportSpec l]
specs

        sortCNames :: ImportSpec l -> ImportSpec l
sortCNames (IThingWith l
l2 Name l
name [CName l]
cNames) = l -> Name l -> [CName l] -> ImportSpec l
forall l. l -> Name l -> [CName l] -> ImportSpec l
IThingWith l
l2 Name l
name ([CName l] -> ImportSpec l)
-> ([CName l] -> [CName l]) -> [CName l] -> ImportSpec l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CName l -> CName l -> Ordering) -> [CName l] -> [CName l]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy CName l -> CName l -> Ordering
forall l. CName l -> CName l -> Ordering
cNameCompare ([CName l] -> ImportSpec l) -> [CName l] -> ImportSpec l
forall a b. (a -> b) -> a -> b
$ [CName l]
cNames
        sortCNames ImportSpec l
is = ImportSpec l
is

groupAdjacentBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupAdjacentBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupAdjacentBy a -> a -> Bool
_ [] = []
groupAdjacentBy a -> a -> Bool
adj [a]
items = [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupAdjacentBy a -> a -> Bool
adj [a]
rest
  where
    ([a]
xs, [a]
rest) = (a -> a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> a -> Bool) -> [a] -> ([a], [a])
spanAdjacentBy a -> a -> Bool
adj [a]
items

spanAdjacentBy :: (a -> a -> Bool) -> [a] -> ([a], [a])
spanAdjacentBy :: (a -> a -> Bool) -> [a] -> ([a], [a])
spanAdjacentBy a -> a -> Bool
_ [] = ([], [])
spanAdjacentBy a -> a -> Bool
_ [a
x] = ([a
x], [])
spanAdjacentBy a -> a -> Bool
adj (a
x:xs :: [a]
xs@(a
y:[a]
_))
  | a -> a -> Bool
adj a
x a
y =
    let ([a]
xs', [a]
rest') = (a -> a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> a -> Bool) -> [a] -> ([a], [a])
spanAdjacentBy a -> a -> Bool
adj [a]
xs
    in (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs', [a]
rest')
  | Bool
otherwise = ([a
x], [a]
xs)

importSpecCompare :: ImportSpec l -> ImportSpec l -> Ordering
importSpecCompare :: ImportSpec l -> ImportSpec l -> Ordering
importSpecCompare (IAbs l
_ Namespace l
_ (Ident l
_ String
s1)) (IAbs l
_ Namespace l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs l
_ Namespace l
_ (Ident l
_ String
_)) (IAbs l
_ Namespace l
_ (Symbol l
_ String
_)) = Ordering
GT
importSpecCompare (IAbs l
_ Namespace l
_ (Ident l
_ String
s1)) (IThingAll l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs l
_ Namespace l
_ (Ident l
_ String
_)) (IThingAll l
_ (Symbol l
_ String
_)) = Ordering
GT
importSpecCompare (IAbs l
_ Namespace l
_ (Ident l
_ String
s1)) (IThingWith l
_ (Ident l
_ String
s2) [CName l]
_) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs l
_ Namespace l
_ (Ident l
_ String
_)) (IThingWith l
_ (Symbol l
_ String
_) [CName l]
_) = Ordering
GT
importSpecCompare (IAbs l
_ Namespace l
_ (Symbol l
_ String
_)) (IAbs l
_ Namespace l
_ (Ident l
_ String
_)) = Ordering
LT
importSpecCompare (IAbs l
_ Namespace l
_ (Symbol l
_ String
s1)) (IAbs l
_ Namespace l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs l
_ Namespace l
_ (Symbol l
_ String
_)) (IThingAll l
_ (Ident l
_ String
_)) = Ordering
LT
importSpecCompare (IAbs l
_ Namespace l
_ (Symbol l
_ String
s1)) (IThingAll l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs l
_ Namespace l
_ (Symbol l
_ String
_)) (IThingWith l
_ (Ident l
_ String
_) [CName l]
_) = Ordering
LT
importSpecCompare (IAbs l
_ Namespace l
_ (Symbol l
_ String
s1)) (IThingWith l
_ (Symbol l
_ String
s2) [CName l]
_) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs l
_ Namespace l
_ Name l
_) (IVar l
_ Name l
_) = Ordering
LT
importSpecCompare (IThingAll l
_ (Ident l
_ String
s1)) (IAbs l
_ Namespace l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll l
_ (Ident l
_ String
_)) (IAbs l
_ Namespace l
_ (Symbol l
_ String
_)) = Ordering
GT
importSpecCompare (IThingAll l
_ (Ident l
_ String
s1)) (IThingAll l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll l
_ (Ident l
_ String
_)) (IThingAll l
_ (Symbol l
_ String
_)) = Ordering
GT
importSpecCompare (IThingAll l
_ (Ident l
_ String
s1)) (IThingWith l
_ (Ident l
_ String
s2) [CName l]
_) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll l
_ (Ident l
_ String
_)) (IThingWith l
_ (Symbol l
_ String
_) [CName l]
_) = Ordering
GT
importSpecCompare (IThingAll l
_ (Symbol l
_ String
_)) (IAbs l
_ Namespace l
_ (Ident l
_ String
_)) = Ordering
LT
importSpecCompare (IThingAll l
_ (Symbol l
_ String
s1)) (IAbs l
_ Namespace l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll l
_ (Symbol l
_ String
_)) (IThingAll l
_ (Ident l
_ String
_)) = Ordering
LT
importSpecCompare (IThingAll l
_ (Symbol l
_ String
s1)) (IThingAll l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll l
_ (Symbol l
_ String
_)) (IThingWith l
_ (Ident l
_ String
_) [CName l]
_) = Ordering
LT
importSpecCompare (IThingAll l
_ (Symbol l
_ String
s1)) (IThingWith l
_ (Symbol l
_ String
s2) [CName l]
_) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll l
_ Name l
_) (IVar l
_ Name l
_) = Ordering
LT
importSpecCompare (IThingWith l
_ (Ident l
_ String
s1) [CName l]
_) (IAbs l
_ Namespace l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith l
_ (Ident l
_ String
_) [CName l]
_) (IAbs l
_ Namespace l
_ (Symbol l
_ String
_)) = Ordering
GT
importSpecCompare (IThingWith l
_ (Ident l
_ String
s1) [CName l]
_) (IThingAll l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith l
_ (Ident l
_ String
_) [CName l]
_) (IThingAll l
_ (Symbol l
_ String
_)) = Ordering
GT
importSpecCompare (IThingWith l
_ (Ident l
_ String
s1) [CName l]
_) (IThingWith l
_ (Ident l
_ String
s2) [CName l]
_) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith l
_ (Ident l
_ String
_) [CName l]
_) (IThingWith l
_ (Symbol l
_ String
_) [CName l]
_) = Ordering
GT
importSpecCompare (IThingWith l
_ (Symbol l
_ String
_) [CName l]
_) (IAbs l
_ Namespace l
_ (Ident l
_ String
_)) = Ordering
LT
importSpecCompare (IThingWith l
_ (Symbol l
_ String
s1) [CName l]
_) (IAbs l
_ Namespace l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith l
_ (Symbol l
_ String
_) [CName l]
_) (IThingAll l
_ (Ident l
_ String
_)) = Ordering
LT
importSpecCompare (IThingWith l
_ (Symbol l
_ String
s1) [CName l]
_) (IThingAll l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith l
_ (Symbol l
_ String
_) [CName l]
_) (IThingWith l
_ (Ident l
_ String
_) [CName l]
_) = Ordering
LT
importSpecCompare (IThingWith l
_ (Symbol l
_ String
s1) [CName l]
_) (IThingWith l
_ (Symbol l
_ String
s2) [CName l]
_) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith l
_ Name l
_ [CName l]
_) (IVar l
_ Name l
_) = Ordering
LT
importSpecCompare (IVar l
_ (Ident l
_ String
s1)) (IVar l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IVar l
_ (Ident l
_ String
_)) (IVar l
_ (Symbol l
_ String
_)) = Ordering
GT
importSpecCompare (IVar l
_ (Symbol l
_ String
_)) (IVar l
_ (Ident l
_ String
_)) = Ordering
LT
importSpecCompare (IVar l
_ (Symbol l
_ String
s1)) (IVar l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IVar l
_ Name l
_) ImportSpec l
_ = Ordering
GT

cNameCompare :: CName l -> CName l -> Ordering
cNameCompare :: CName l -> CName l -> Ordering
cNameCompare (VarName l
_ (Ident l
_ String
s1)) (VarName l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (VarName l
_ (Ident l
_ String
_)) (VarName l
_ (Symbol l
_ String
_)) = Ordering
GT
cNameCompare (VarName l
_ (Ident l
_ String
s1)) (ConName l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (VarName l
_ (Ident l
_ String
_)) (ConName l
_ (Symbol l
_ String
_)) = Ordering
GT
cNameCompare (VarName l
_ (Symbol l
_ String
_)) (VarName l
_ (Ident l
_ String
_)) = Ordering
LT
cNameCompare (VarName l
_ (Symbol l
_ String
s1)) (VarName l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (VarName l
_ (Symbol l
_ String
_)) (ConName l
_ (Ident l
_ String
_)) = Ordering
LT
cNameCompare (VarName l
_ (Symbol l
_ String
s1)) (ConName l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (ConName l
_ (Ident l
_ String
s1)) (VarName l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (ConName l
_ (Ident l
_ String
_)) (VarName l
_ (Symbol l
_ String
_)) = Ordering
GT
cNameCompare (ConName l
_ (Ident l
_ String
s1)) (ConName l
_ (Ident l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (ConName l
_ (Ident l
_ String
_)) (ConName l
_ (Symbol l
_ String
_)) = Ordering
GT
cNameCompare (ConName l
_ (Symbol l
_ String
_)) (VarName l
_ (Ident l
_ String
_)) = Ordering
LT
cNameCompare (ConName l
_ (Symbol l
_ String
s1)) (VarName l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (ConName l
_ (Symbol l
_ String
_)) (ConName l
_ (Ident l
_ String
_)) = Ordering
LT
cNameCompare (ConName l
_ (Symbol l
_ String
s1)) (ConName l
_ (Symbol l
_ String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2

instance Pretty Bracket where
  prettyInternal :: Bracket NodeInfo -> Printer ()
prettyInternal Bracket NodeInfo
x =
    case Bracket NodeInfo
x of
      ExpBracket NodeInfo
_ Exp NodeInfo
p -> String -> Printer () -> Printer ()
quotation String
"" (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
p)
      PatBracket NodeInfo
_ Pat NodeInfo
p -> String -> Printer () -> Printer ()
quotation String
"p" (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
      TypeBracket NodeInfo
_ Type NodeInfo
ty -> String -> Printer () -> Printer ()
quotation String
"t" (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
      d :: Bracket NodeInfo
d@(DeclBracket NodeInfo
_ [Decl NodeInfo]
_) -> Bracket NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Bracket NodeInfo
d

instance Pretty IPBind where
  prettyInternal :: IPBind NodeInfo -> Printer ()
prettyInternal IPBind NodeInfo
x =
    case IPBind NodeInfo
x of
      IPBind NodeInfo
_ IPName NodeInfo
name Exp NodeInfo
expr -> do
        IPName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty IPName NodeInfo
name
        Printer ()
space
        String -> Printer ()
write String
"="
        Printer ()
space
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
expr

instance Pretty BooleanFormula where
  prettyInternal :: BooleanFormula NodeInfo -> Printer ()
prettyInternal (VarFormula NodeInfo
_ i :: Name NodeInfo
i@(Ident NodeInfo
_ String
_)) = Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Name NodeInfo
i
  prettyInternal (VarFormula NodeInfo
_ (Symbol NodeInfo
_ String
s)) = String -> Printer ()
write String
"(" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
string String
s Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
write String
")"
  prettyInternal (AndFormula NodeInfo
_ [BooleanFormula NodeInfo]
fs) = do
      Maybe PrintState
maybeFormulas <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer () -> Printer (Maybe PrintState))
-> Printer () -> Printer (Maybe PrintState)
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
", ") ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (BooleanFormula NodeInfo -> Printer ())
-> [BooleanFormula NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map BooleanFormula NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [BooleanFormula NodeInfo]
fs
      case Maybe PrintState
maybeFormulas of
        Maybe PrintState
Nothing -> String -> [Printer ()] -> Printer ()
prefixedLined String
", " ((BooleanFormula NodeInfo -> Printer ())
-> [BooleanFormula NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map BooleanFormula NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [BooleanFormula NodeInfo]
fs)
        Just PrintState
formulas -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
formulas
  prettyInternal (OrFormula NodeInfo
_ [BooleanFormula NodeInfo]
fs) = do
      Maybe PrintState
maybeFormulas <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer () -> Printer (Maybe PrintState))
-> Printer () -> Printer (Maybe PrintState)
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
" | ") ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (BooleanFormula NodeInfo -> Printer ())
-> [BooleanFormula NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map BooleanFormula NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [BooleanFormula NodeInfo]
fs
      case Maybe PrintState
maybeFormulas of
        Maybe PrintState
Nothing -> String -> [Printer ()] -> Printer ()
prefixedLined String
"| " ((BooleanFormula NodeInfo -> Printer ())
-> [BooleanFormula NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map BooleanFormula NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [BooleanFormula NodeInfo]
fs)
        Just PrintState
formulas -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
formulas
  prettyInternal (ParenFormula NodeInfo
_ BooleanFormula NodeInfo
f) = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ BooleanFormula NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty BooleanFormula NodeInfo
f

--------------------------------------------------------------------------------
-- * Fallback printers

instance Pretty DataOrNew where
  prettyInternal :: DataOrNew NodeInfo -> Printer ()
prettyInternal = DataOrNew NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'

instance Pretty FunDep where
  prettyInternal :: FunDep NodeInfo -> Printer ()
prettyInternal = FunDep NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'

#if !MIN_VERSION_haskell_src_exts(1,21,0)
instance Pretty Kind where
  prettyInternal = pretty'
#endif

instance Pretty ResultSig where
  prettyInternal :: ResultSig NodeInfo -> Printer ()
prettyInternal (KindSig NodeInfo
_ Type NodeInfo
kind) = Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
  prettyInternal (TyVarSig NodeInfo
_ TyVarBind NodeInfo
tyVarBind) = TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty TyVarBind NodeInfo
tyVarBind

instance Pretty Literal where
  prettyInternal :: Literal NodeInfo -> Printer ()
prettyInternal (String NodeInfo
_ String
_ String
rep) = do
    String -> Printer ()
write String
"\""
    String -> Printer ()
string String
rep
    String -> Printer ()
write String
"\""
  prettyInternal (Char NodeInfo
_ Char
_ String
rep) = do
    String -> Printer ()
write String
"'"
    String -> Printer ()
string String
rep
    String -> Printer ()
write String
"'"
  prettyInternal (PrimString NodeInfo
_ String
_ String
rep) = do
    String -> Printer ()
write String
"\""
    String -> Printer ()
string String
rep
    String -> Printer ()
write String
"\"#"
  prettyInternal (PrimChar NodeInfo
_ Char
_ String
rep) = do
    String -> Printer ()
write String
"'"
    String -> Printer ()
string String
rep
    String -> Printer ()
write String
"'#"
  -- We print the original notation (because HSE doesn't track Hex
  -- vs binary vs decimal notation).
  prettyInternal (Int NodeInfo
_l Integer
_i String
originalString) =
    String -> Printer ()
string String
originalString
  prettyInternal (Frac NodeInfo
_l Rational
_r String
originalString) =
    String -> Printer ()
string String
originalString
  prettyInternal Literal NodeInfo
x = Literal NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Literal NodeInfo
x

instance Pretty Name where
  prettyInternal :: Name NodeInfo -> Printer ()
prettyInternal Name NodeInfo
x = case Name NodeInfo
x of
                          Ident NodeInfo
_ String
_ -> Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Name NodeInfo
x -- Identifiers.
                          Symbol NodeInfo
_ String
s -> String -> Printer ()
string String
s -- Symbols

instance Pretty QName where
  prettyInternal :: QName NodeInfo -> Printer ()
prettyInternal =
    \case
      Qual NodeInfo
_ ModuleName NodeInfo
mn Name NodeInfo
n ->
        case Name NodeInfo
n of
          Ident NodeInfo
_ String
i -> do ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
mn; String -> Printer ()
write String
"."; String -> Printer ()
string String
i;
          Symbol NodeInfo
_ String
s -> do String -> Printer ()
write String
"("; ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
mn; String -> Printer ()
write String
"."; String -> Printer ()
string String
s; String -> Printer ()
write String
")";
      UnQual NodeInfo
_ Name NodeInfo
n ->
        case Name NodeInfo
n of
          Ident NodeInfo
_ String
i -> String -> Printer ()
string String
i
          Symbol NodeInfo
_ String
s -> do String -> Printer ()
write String
"("; String -> Printer ()
string String
s; String -> Printer ()
write String
")";
      Special NodeInfo
_ s :: SpecialCon NodeInfo
s@Cons{} -> Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (SpecialCon NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty SpecialCon NodeInfo
s)
      Special NodeInfo
_ s :: SpecialCon NodeInfo
s@FunCon{} -> Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (SpecialCon NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty SpecialCon NodeInfo
s)
      Special NodeInfo
_ SpecialCon NodeInfo
s -> SpecialCon NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty SpecialCon NodeInfo
s


instance Pretty SpecialCon where
  prettyInternal :: SpecialCon NodeInfo -> Printer ()
prettyInternal SpecialCon NodeInfo
s =
    case SpecialCon NodeInfo
s of
      UnitCon NodeInfo
_ -> String -> Printer ()
write String
"()"
      ListCon NodeInfo
_ -> String -> Printer ()
write String
"[]"
      FunCon NodeInfo
_ -> String -> Printer ()
write String
"->"
      TupleCon NodeInfo
_ Boxed
Boxed Int
i ->
        String -> Printer ()
string (String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Char
',' String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
")")
      TupleCon NodeInfo
_ Boxed
Unboxed Int
i ->
        String -> Printer ()
string (String
"(# " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Char
',' String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
" #)")
      Cons NodeInfo
_ -> String -> Printer ()
write String
":"
      UnboxedSingleCon NodeInfo
_ -> String -> Printer ()
write String
"(##)"
      ExprHole NodeInfo
_ -> String -> Printer ()
write String
"_"

instance Pretty QOp where
  prettyInternal :: QOp NodeInfo -> Printer ()
prettyInternal = QOp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'

instance Pretty TyVarBind where
  prettyInternal :: TyVarBind NodeInfo -> Printer ()
prettyInternal = TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'

instance Pretty ModuleHead where
  prettyInternal :: ModuleHead NodeInfo -> Printer ()
prettyInternal (ModuleHead NodeInfo
_ ModuleName NodeInfo
name Maybe (WarningText NodeInfo)
mwarnings Maybe (ExportSpecList NodeInfo)
mexports) =
    do String -> Printer ()
write String
"module "
       ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
name
       Printer ()
-> (WarningText NodeInfo -> Printer ())
-> Maybe (WarningText NodeInfo)
-> Printer ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) WarningText NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Maybe (WarningText NodeInfo)
mwarnings
       Printer ()
-> (ExportSpecList NodeInfo -> Printer ())
-> Maybe (ExportSpecList NodeInfo)
-> Printer ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
             (\ExportSpecList NodeInfo
exports ->
                do Printer ()
newline
                   Int64
indentSpaces <- Printer Int64
getIndentSpaces
                   Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
indentSpaces (ExportSpecList NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ExportSpecList NodeInfo
exports))
             Maybe (ExportSpecList NodeInfo)
mexports
       String -> Printer ()
write String
" where"

instance Pretty ModulePragma where
  prettyInternal :: ModulePragma NodeInfo -> Printer ()
prettyInternal = ModulePragma NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'

instance Pretty ImportDecl where
  prettyInternal :: ImportDecl NodeInfo -> Printer ()
prettyInternal (ImportDecl NodeInfo
_ ModuleName NodeInfo
name Bool
qualified Bool
source Bool
safe Maybe String
mpkg Maybe (ModuleName NodeInfo)
mas Maybe (ImportSpecList NodeInfo)
mspec) = do
    String -> Printer ()
write String
"import"
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
source (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
write String
" {-# SOURCE #-}"
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
safe (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
write String
" safe"
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
qualified (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
write String
" qualified"
    case Maybe String
mpkg of
      Maybe String
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just String
pkg -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
write (String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pkg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"")
    Printer ()
space
    ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
name
    case Maybe (ModuleName NodeInfo)
mas of
      Maybe (ModuleName NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just ModuleName NodeInfo
asName -> do
        Printer ()
space
        String -> Printer ()
write String
"as "
        ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
asName
    case Maybe (ImportSpecList NodeInfo)
mspec of
      Maybe (ImportSpecList NodeInfo)
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just ImportSpecList NodeInfo
spec -> ImportSpecList NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ImportSpecList NodeInfo
spec

instance Pretty ModuleName where
  prettyInternal :: ModuleName NodeInfo -> Printer ()
prettyInternal (ModuleName NodeInfo
_ String
name) =
    String -> Printer ()
write String
name

instance Pretty ImportSpecList where
  prettyInternal :: ImportSpecList NodeInfo -> Printer ()
prettyInternal (ImportSpecList NodeInfo
_ Bool
hiding [ImportSpec NodeInfo]
spec) = do
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hiding (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
write String
" hiding"
    let verVar :: Printer ()
verVar = do
          Printer ()
space
          Printer () -> Printer ()
forall a. Printer a -> Printer a
parens ([Printer ()] -> Printer ()
commas ((ImportSpec NodeInfo -> Printer ())
-> [ImportSpec NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ImportSpec NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [ImportSpec NodeInfo]
spec))
    let horVar :: Printer ()
horVar = do
          Printer ()
newline
          Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock
            (do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"( ") (String -> [Printer ()] -> Printer ()
prefixedLined String
", " ((ImportSpec NodeInfo -> Printer ())
-> [ImportSpec NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ImportSpec NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [ImportSpec NodeInfo]
spec))
                Printer ()
newline
                String -> Printer ()
write String
")")
    Printer ()
verVar Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
horVar

instance Pretty ImportSpec where
  prettyInternal :: ImportSpec NodeInfo -> Printer ()
prettyInternal = ImportSpec NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty'

instance Pretty WarningText where
  prettyInternal :: WarningText NodeInfo -> Printer ()
prettyInternal (DeprText NodeInfo
_ String
s) =
    String -> Printer ()
write String
"{-# DEPRECATED " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
string String
s Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
write String
" #-}"
  prettyInternal (WarnText NodeInfo
_ String
s) =
    String -> Printer ()
write String
"{-# WARNING " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
string String
s Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
write String
" #-}"

instance Pretty ExportSpecList where
  prettyInternal :: ExportSpecList NodeInfo -> Printer ()
prettyInternal (ExportSpecList NodeInfo
_ [ExportSpec NodeInfo]
es) = do
    Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"(")
           (String -> [Printer ()] -> Printer ()
prefixedLined String
"," ((ExportSpec NodeInfo -> Printer ())
-> [ExportSpec NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map ExportSpec NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [ExportSpec NodeInfo]
es))
    Printer ()
newline
    String -> Printer ()
write String
")"

instance Pretty ExportSpec where
  prettyInternal :: ExportSpec NodeInfo -> Printer ()
prettyInternal ExportSpec NodeInfo
x = String -> Printer ()
string String
" " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExportSpec NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' ExportSpec NodeInfo
x

-- Do statements need to handle infix expression indentation specially because
-- do x *
--    y
-- is two invalid statements, not one valid infix op.
stmt :: Stmt NodeInfo -> Printer ()
stmt :: Stmt NodeInfo -> Printer ()
stmt (Qualifier NodeInfo
_ e :: Exp NodeInfo
e@(InfixApp NodeInfo
_ Exp NodeInfo
a QOp NodeInfo
op Exp NodeInfo
b)) =
  do Int64
col <- (((), PrintState) -> Int64)
-> Printer ((), PrintState) -> Printer Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrintState -> Int64
psColumn (PrintState -> Int64)
-> (((), PrintState) -> PrintState) -> ((), PrintState) -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((), PrintState) -> PrintState
forall a b. (a, b) -> b
snd)
                 (Printer () -> Printer ((), PrintState)
forall a. Printer a -> Printer (a, PrintState)
sandbox (String -> Printer ()
write String
""))
     Exp NodeInfo
-> Exp NodeInfo
-> QOp NodeInfo
-> Exp NodeInfo
-> Maybe Int64
-> Printer ()
infixApp Exp NodeInfo
e Exp NodeInfo
a QOp NodeInfo
op Exp NodeInfo
b (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
col)
stmt (Generator NodeInfo
_ Pat NodeInfo
p Exp NodeInfo
e) =
  do Int64
indentSpaces <- Printer Int64
getIndentSpaces
     Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p
     Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
indentSpaces
              (Printer ()
-> Printer ()
-> Exp NodeInfo
-> (Exp NodeInfo -> Printer ())
-> Printer ()
dependOrNewline
                 (String -> Printer ()
write String
" <-")
                 Printer ()
space
                 Exp NodeInfo
e
                 Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty)
stmt Stmt NodeInfo
x = case Stmt NodeInfo
x of
           Generator NodeInfo
_ Pat NodeInfo
p Exp NodeInfo
e ->
             Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p
                        String -> Printer ()
write String
" <- ")
                    (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
           Qualifier NodeInfo
_ Exp NodeInfo
e -> Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
           LetStmt NodeInfo
_ Binds NodeInfo
binds ->
             Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"let ")
                    (Binds NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Binds NodeInfo
binds)
           RecStmt NodeInfo
_ [Stmt NodeInfo]
es ->
             Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"rec ")
                    ([Printer ()] -> Printer ()
lined ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
es))

-- | Make the right hand side dependent if it fits on one line,
-- otherwise send it to the next line.
dependOrNewline
  :: Printer ()
  -> Printer ()
  -> Exp NodeInfo
  -> (Exp NodeInfo -> Printer ())
  -> Printer ()
dependOrNewline :: Printer ()
-> Printer ()
-> Exp NodeInfo
-> (Exp NodeInfo -> Printer ())
-> Printer ()
dependOrNewline Printer ()
left Printer ()
prefix Exp NodeInfo
right Exp NodeInfo -> Printer ()
f =
  do Maybe PrintState
msg <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine Printer ()
renderDependent
     case Maybe PrintState
msg of
       Maybe PrintState
Nothing -> do Printer ()
left
                     Printer ()
newline
                     (Exp NodeInfo -> Printer ()
f Exp NodeInfo
right)
       Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
  where renderDependent :: Printer ()
renderDependent = Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
left (do Printer ()
prefix; Exp NodeInfo -> Printer ()
f Exp NodeInfo
right)

-- | Handle do and case specially and also space out guards more.
rhs :: Rhs NodeInfo -> Printer ()
rhs :: Rhs NodeInfo -> Printer ()
rhs (UnGuardedRhs NodeInfo
_ (Do NodeInfo
_ [Stmt NodeInfo]
dos)) =
  do Bool
inCase <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psInsideCase
     String -> Printer ()
write (if Bool
inCase then String
" -> " else String
" = ")
     Int64
indentSpaces <- Printer Int64
getIndentSpaces
     let indentation :: Int64
indentation | Bool
inCase = Int64
indentSpaces
                     | Bool
otherwise = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max Int64
2 Int64
indentSpaces
     Int64 -> Printer () -> Printer () -> Printer ()
forall b. Int64 -> Printer () -> Printer b -> Printer b
swingBy Int64
indentation
             (String -> Printer ()
write String
"do")
             ([Printer ()] -> Printer ()
lined ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
dos))
rhs (UnGuardedRhs NodeInfo
_ Exp NodeInfo
e) = do
  Maybe PrintState
msg <-
    Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine
      (do String -> Printer ()
write String
" "
          Printer ()
rhsSeparator
          String -> Printer ()
write String
" "
          Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
  case Maybe PrintState
msg of
    Maybe PrintState
Nothing -> Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write String
" " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
rhsSeparator) (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
    Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
rhs (GuardedRhss NodeInfo
_ [GuardedRhs NodeInfo]
gas) =
  do Printer ()
newline
     Int64
n <- Printer Int64
getIndentSpaces
     Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
n
              ([Printer ()] -> Printer ()
lined ((GuardedRhs NodeInfo -> Printer ())
-> [GuardedRhs NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (\GuardedRhs NodeInfo
p ->
                             do String -> Printer ()
write String
"|"
                                GuardedRhs NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty GuardedRhs NodeInfo
p)
                          [GuardedRhs NodeInfo]
gas))

-- | Implement dangling right-hand-sides.
guardedRhs :: GuardedRhs NodeInfo -> Printer ()
-- | Handle do specially.

guardedRhs :: GuardedRhs NodeInfo -> Printer ()
guardedRhs (GuardedRhs NodeInfo
_ [Stmt NodeInfo]
stmts (Do NodeInfo
_ [Stmt NodeInfo]
dos)) =
  do Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
1
              (do String -> [Printer ()] -> Printer ()
prefixedLined
                    String
","
                    ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (\Stmt NodeInfo
p ->
                            do Printer ()
space
                               Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Stmt NodeInfo
p)
                         [Stmt NodeInfo]
stmts))
     Bool
inCase <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psInsideCase
     String -> Printer ()
write (if Bool
inCase then String
" -> " else String
" = ")
     Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write String
"do")
            ([Printer ()] -> Printer ()
lined ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
dos))
guardedRhs (GuardedRhs NodeInfo
_ [Stmt NodeInfo]
stmts Exp NodeInfo
e) = do
    Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine Printer ()
printStmts
    case Maybe PrintState
mst of
      Just PrintState
st -> do
        PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
        Maybe PrintState
mst' <-
          Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine
            (do String -> Printer ()
write String
" "
                Printer ()
rhsSeparator
                String -> Printer ()
write String
" "
                Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
        case Maybe PrintState
mst' of
          Just PrintState
st' -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st'
          Maybe PrintState
Nothing -> Printer ()
swingIt
      Maybe PrintState
Nothing -> do
        Printer ()
printStmts
        Printer ()
swingIt
  where
    printStmts :: Printer ()
printStmts =
      Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented
        Int64
1
        (do String -> [Printer ()] -> Printer ()
prefixedLined
              String
","
              ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map
                 (\Stmt NodeInfo
p -> do
                    Printer ()
space
                    Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Stmt NodeInfo
p)
                 [Stmt NodeInfo]
stmts))
    swingIt :: Printer ()
swingIt = Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write String
" " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
rhsSeparator) (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)

match :: Match NodeInfo -> Printer ()
match :: Match NodeInfo -> Printer ()
match (Match NodeInfo
_ Name NodeInfo
name [Pat NodeInfo]
pats Rhs NodeInfo
rhs' Maybe (Binds NodeInfo)
mbinds) =
  do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do case Name NodeInfo
name of
                  Ident NodeInfo
_ String
_ ->
                    Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
                  Symbol NodeInfo
_ String
_ ->
                    do String -> Printer ()
write String
"("
                       Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
                       String -> Printer ()
write String
")"
                Printer ()
space)
       ([Printer ()] -> Printer ()
spaced ((Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
pats))
     Bool -> Printer () -> Printer ()
forall a. Bool -> Printer a -> Printer a
withCaseContext Bool
False (Rhs NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Rhs NodeInfo
rhs')
     Maybe (Binds NodeInfo)
-> (Binds NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (Binds NodeInfo)
mbinds Binds NodeInfo -> Printer ()
bindingGroup
match (InfixMatch NodeInfo
_ Pat NodeInfo
pat1 Name NodeInfo
name [Pat NodeInfo]
pats Rhs NodeInfo
rhs' Maybe (Binds NodeInfo)
mbinds) =
  do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat1
                Printer ()
space
                Name NodeInfo -> Printer ()
prettyInfixName Name NodeInfo
name)
            (do Printer ()
space
                [Printer ()] -> Printer ()
spaced ((Pat NodeInfo -> Printer ()) -> [Pat NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Pat NodeInfo]
pats))
     Bool -> Printer () -> Printer ()
forall a. Bool -> Printer a -> Printer a
withCaseContext Bool
False (Rhs NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Rhs NodeInfo
rhs')
     Maybe (Binds NodeInfo)
-> (Binds NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (Binds NodeInfo)
mbinds Binds NodeInfo -> Printer ()
bindingGroup

-- | Format contexts with spaces and commas between class constraints.
context :: Context NodeInfo -> Printer ()
context :: Context NodeInfo -> Printer ()
context Context NodeInfo
ctx =
  case Context NodeInfo
ctx of
    CxSingle NodeInfo
_ Asst NodeInfo
a -> Asst NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Asst NodeInfo
a
    CxTuple NodeInfo
_ [Asst NodeInfo]
as -> do
      Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"( ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
", " ((Asst NodeInfo -> Printer ()) -> [Asst NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Asst NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Asst NodeInfo]
as)
      Printer ()
newline
      String -> Printer ()
write String
")"
    CxEmpty NodeInfo
_ -> Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

typ :: Type NodeInfo -> Printer ()
typ :: Type NodeInfo -> Printer ()
typ (TyTuple NodeInfo
_ Boxed
Boxed [Type NodeInfo]
types) = do
  let horVar :: Printer ()
horVar = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
", ") ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
types)
  let verVar :: Printer ()
verVar = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
"," ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (Type NodeInfo -> Printer ()) -> Type NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [Type NodeInfo]
types)
  Printer ()
horVar Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVar
typ (TyTuple NodeInfo
_ Boxed
Unboxed [Type NodeInfo]
types) = do
  let horVar :: Printer ()
horVar = String -> String -> Printer () -> Printer ()
forall a. String -> String -> Printer a -> Printer a
wrap String
"(# " String
" #)" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write String
", ") ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
types)
  let verVar :: Printer ()
verVar = String -> String -> Printer () -> Printer ()
forall a. String -> String -> Printer a -> Printer a
wrap String
"(#" String
" #)" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
"," ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (Type NodeInfo -> Printer ()) -> Type NodeInfo -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [Type NodeInfo]
types)
  Printer ()
horVar Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVar
typ (TyForall NodeInfo
_ Maybe [TyVarBind NodeInfo]
mbinds Maybe (Context NodeInfo)
ctx Type NodeInfo
ty) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (case Maybe [TyVarBind NodeInfo]
mbinds of
            Maybe [TyVarBind NodeInfo]
Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just [TyVarBind NodeInfo]
ts ->
              do String -> Printer ()
write String
"forall "
                 [Printer ()] -> Printer ()
spaced ((TyVarBind NodeInfo -> Printer ())
-> [TyVarBind NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [TyVarBind NodeInfo]
ts)
                 String -> Printer ()
write String
". ")
         (do Int64
indentSpaces <- Printer Int64
getIndentSpaces
             Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (Context NodeInfo)
ctx (Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
indentSpaces (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)))
typ (TyFun NodeInfo
_ Type NodeInfo
a Type NodeInfo
b) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
a
             String -> Printer ()
write String
" -> ")
         (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
b)
typ (TyList NodeInfo
_ Type NodeInfo
t) = Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
t)
typ (TyParArray NodeInfo
_ Type NodeInfo
t) =
  Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (do String -> Printer ()
write String
":"
               Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
t
               String -> Printer ()
write String
":")
typ (TyApp NodeInfo
_ Type NodeInfo
f Type NodeInfo
a) = [Printer ()] -> Printer ()
spaced [Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
f, Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
a]
typ (TyVar NodeInfo
_ Name NodeInfo
n) = Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
n
typ (TyCon NodeInfo
_ QName NodeInfo
p) = QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
p
typ (TyParen NodeInfo
_ Type NodeInfo
e) = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
e)
typ (TyInfix NodeInfo
_ Type NodeInfo
a MaybePromotedName NodeInfo
promotedop Type NodeInfo
b) = do
  -- Apply special rules to line-break operators.
  let isLineBreak' :: MaybePromotedName NodeInfo -> Printer Bool
isLineBreak' MaybePromotedName NodeInfo
op =
        case MaybePromotedName NodeInfo
op of
          PromotedName NodeInfo
_ QName NodeInfo
op' -> QName NodeInfo -> Printer Bool
isLineBreak QName NodeInfo
op'
          UnpromotedName NodeInfo
_ QName NodeInfo
op' -> QName NodeInfo -> Printer Bool
isLineBreak QName NodeInfo
op'
      prettyInfixOp' :: MaybePromotedName NodeInfo -> Printer ()
prettyInfixOp' MaybePromotedName NodeInfo
op =
        case MaybePromotedName NodeInfo
op of
          PromotedName NodeInfo
_ QName NodeInfo
op' -> String -> Printer ()
write String
"'" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName NodeInfo -> Printer ()
prettyInfixOp QName NodeInfo
op'
          UnpromotedName NodeInfo
_ QName NodeInfo
op' -> QName NodeInfo -> Printer ()
prettyInfixOp QName NodeInfo
op'
  Bool
linebreak <- MaybePromotedName NodeInfo -> Printer Bool
isLineBreak' MaybePromotedName NodeInfo
promotedop
  if Bool
linebreak
    then do Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
a
            Printer ()
newline
            MaybePromotedName NodeInfo -> Printer ()
prettyInfixOp' MaybePromotedName NodeInfo
promotedop
            Printer ()
space
            Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
b
    else do Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
a
            Printer ()
space
            MaybePromotedName NodeInfo -> Printer ()
prettyInfixOp' MaybePromotedName NodeInfo
promotedop
            Printer ()
space
            Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
b
typ (TyKind NodeInfo
_ Type NodeInfo
ty Type NodeInfo
k) =
  Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (do Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
             String -> Printer ()
write String
" :: "
             Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
k)
typ (TyBang NodeInfo
_ BangType NodeInfo
bangty Unpackedness NodeInfo
unpackty Type NodeInfo
right) =
  do Unpackedness NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Unpackedness NodeInfo
unpackty
     BangType NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty BangType NodeInfo
bangty
     Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
right
typ (TyEquals NodeInfo
_ Type NodeInfo
left Type NodeInfo
right) =
  do Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
left
     String -> Printer ()
write String
" ~ "
     Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
right
typ (TyPromoted NodeInfo
_ (PromotedList NodeInfo
_ Bool
_ [Type NodeInfo]
ts)) =
  do String -> Printer ()
write String
"'["
     Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Type NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type NodeInfo]
ts) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
write String
" "
     [Printer ()] -> Printer ()
commas ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
ts)
     String -> Printer ()
write String
"]"
typ (TyPromoted NodeInfo
_ (PromotedTuple NodeInfo
_ [Type NodeInfo]
ts)) =
  do String -> Printer ()
write String
"'("
     Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Type NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type NodeInfo]
ts) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
write String
" "
     [Printer ()] -> Printer ()
commas ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
ts)
     String -> Printer ()
write String
")"
typ (TyPromoted NodeInfo
_ (PromotedCon NodeInfo
_ Bool
_ QName NodeInfo
tname)) =
  do String -> Printer ()
write String
"'"
     QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
tname
typ (TyPromoted NodeInfo
_ (PromotedString NodeInfo
_ String
_ String
raw)) = do
  do String -> Printer ()
write String
"\""
     String -> Printer ()
string String
raw
     String -> Printer ()
write String
"\""
typ ty :: Type NodeInfo
ty@TyPromoted{} = Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
typ (TySplice NodeInfo
_ Splice NodeInfo
splice) = Splice NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Splice NodeInfo
splice
typ (TyWildCard NodeInfo
_ Maybe (Name NodeInfo)
name) =
  case Maybe (Name NodeInfo)
name of
    Maybe (Name NodeInfo)
Nothing -> String -> Printer ()
write String
"_"
    Just Name NodeInfo
n ->
      do String -> Printer ()
write String
"_"
         Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
n
typ (TyQuasiQuote NodeInfo
_ String
n String
s) = String -> Printer () -> Printer ()
quotation String
n (String -> Printer ()
string String
s)
typ (TyUnboxedSum{}) = String -> Printer ()
forall a. HasCallStack => String -> a
error String
"FIXME: No implementation for TyUnboxedSum."
#if MIN_VERSION_haskell_src_exts(1,21,0)
typ (TyStar NodeInfo
_) = String -> Printer ()
write String
"*"
#endif

prettyTopName :: Name NodeInfo -> Printer ()
prettyTopName :: Name NodeInfo -> Printer ()
prettyTopName x :: Name NodeInfo
x@Ident{} = Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
x
prettyTopName x :: Name NodeInfo
x@Symbol{} = Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
x

-- | Specially format records. Indent where clauses only 2 spaces.
decl' :: Decl NodeInfo -> Printer ()
-- | Pretty print type signatures like
--
-- foo :: (Show x, Read x)
--     => (Foo -> Bar)
--     -> Maybe Int
--     -> (Char -> X -> Y)
--     -> IO ()
--
decl' :: Decl NodeInfo -> Printer ()
decl' (TypeSig NodeInfo
_ [Name NodeInfo]
names Type NodeInfo
ty') = do
  Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do [Printer ()] -> Printer ()
commas ((Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
prettyTopName [Name NodeInfo]
names)
                                   String -> Printer ()
write String
" :: ")
                               (Type NodeInfo -> Printer ()
declTy Type NodeInfo
ty'))
  case Maybe PrintState
mst of
    Maybe PrintState
Nothing -> do
      [Printer ()] -> Printer ()
commas ((Name NodeInfo -> Printer ()) -> [Name NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Printer ()
prettyTopName [Name NodeInfo]
names)
      Int64
indentSpaces <- Printer Int64
getIndentSpaces
      if Int64
allNamesLength Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
indentSpaces
        then do String -> Printer ()
write String
" ::"
                Printer ()
newline
                Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
indentSpaces (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"   ") (Type NodeInfo -> Printer ()
declTy Type NodeInfo
ty'))
        else (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
" :: ") (Type NodeInfo -> Printer ()
declTy Type NodeInfo
ty'))
    Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
  where
    nameLength :: Name l -> Int
nameLength (Ident l
_ String
s) = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
    nameLength (Symbol l
_ String
s) = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
    allNamesLength :: Int64
allNamesLength = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Name NodeInfo -> Int) -> [Name NodeInfo] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Name NodeInfo -> Int
forall l. Name l -> Int
nameLength [Name NodeInfo]
names) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* ([Name NodeInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name NodeInfo]
names Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

decl' (PatBind NodeInfo
_ Pat NodeInfo
pat Rhs NodeInfo
rhs' Maybe (Binds NodeInfo)
mbinds) =
  Bool -> Printer () -> Printer ()
forall a. Bool -> Printer a -> Printer a
withCaseContext Bool
False (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
    do Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
pat
       Rhs NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Rhs NodeInfo
rhs'
       Maybe (Binds NodeInfo)
-> (Binds NodeInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (Binds NodeInfo)
mbinds Binds NodeInfo -> Printer ()
bindingGroup

-- | Handle records specially for a prettier display (see guide).
decl' Decl NodeInfo
e = Decl NodeInfo -> Printer ()
decl Decl NodeInfo
e

declTy :: Type NodeInfo -> Printer ()
declTy :: Type NodeInfo -> Printer ()
declTy Type NodeInfo
dty =
  case Type NodeInfo
dty of
    TyForall NodeInfo
_ Maybe [TyVarBind NodeInfo]
mbinds Maybe (Context NodeInfo)
mctx Type NodeInfo
ty ->
      case Maybe [TyVarBind NodeInfo]
mbinds of
        Maybe [TyVarBind NodeInfo]
Nothing -> do
          case Maybe (Context NodeInfo)
mctx of
            Maybe (Context NodeInfo)
Nothing -> Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
False Type NodeInfo
ty
            Just Context NodeInfo
ctx -> do
              Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (do Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Context NodeInfo
ctx
                                       Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
" => ") (Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
False Type NodeInfo
ty))
              case Maybe PrintState
mst of
                Maybe PrintState
Nothing -> do
                  Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Context NodeInfo
ctx
                  Printer ()
newline
                  Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented (-Int64
3) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"=> ") (Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
True Type NodeInfo
ty))
                Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
        Just [TyVarBind NodeInfo]
ts -> do
          String -> Printer ()
write String
"forall "
          [Printer ()] -> Printer ()
spaced ((TyVarBind NodeInfo -> Printer ())
-> [TyVarBind NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [TyVarBind NodeInfo]
ts)
          String -> Printer ()
write String
"."
          case Maybe (Context NodeInfo)
mctx of
            Maybe (Context NodeInfo)
Nothing -> do
              Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
False Type NodeInfo
ty)
              case Maybe PrintState
mst of
                Maybe PrintState
Nothing -> do
                  Printer ()
newline
                  Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
True Type NodeInfo
ty
                Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
            Just Context NodeInfo
ctx -> do
              Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Context NodeInfo
ctx)
              case Maybe PrintState
mst of
                Maybe PrintState
Nothing -> do
                  Printer ()
newline
                  Context NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Context NodeInfo
ctx
                  Printer ()
newline
                  Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented (-Int64
3) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"=> ") (Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
True Type NodeInfo
ty))
                Just PrintState
st -> do
                  PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
                  Printer ()
newline
                  Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented (-Int64
3) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"=> ") (Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
True Type NodeInfo
ty))
    Type NodeInfo
_ -> Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
False Type NodeInfo
dty
  where
    collapseFaps :: Type l -> [Type l]
collapseFaps (TyFun l
_ Type l
arg Type l
result) = Type l
arg Type l -> [Type l] -> [Type l]
forall a. a -> [a] -> [a]
: Type l -> [Type l]
collapseFaps Type l
result
    collapseFaps Type l
e = [Type l
e]
    prettyTy :: Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
breakLine Type NodeInfo
ty = do
      if Bool
breakLine
        then
          case Type NodeInfo -> [Type NodeInfo]
forall l. Type l -> [Type l]
collapseFaps Type NodeInfo
ty of
            [] -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
            [Type NodeInfo]
tys -> String -> [Printer ()] -> Printer ()
prefixedLined String
"-> " ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
tys)
        else do
          Maybe PrintState
mst <- Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
          case Maybe PrintState
mst of
            Maybe PrintState
Nothing ->
              case Type NodeInfo -> [Type NodeInfo]
forall l. Type l -> [Type l]
collapseFaps Type NodeInfo
ty of
                [] -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
                [Type NodeInfo]
tys -> String -> [Printer ()] -> Printer ()
prefixedLined String
"-> " ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
tys)
            Just PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st

-- | Use special record display, used by 'dataDecl' in a record scenario.
qualConDecl :: QualConDecl NodeInfo -> Printer ()
qualConDecl :: QualConDecl NodeInfo -> Printer ()
qualConDecl (QualConDecl NodeInfo
_ Maybe [TyVarBind NodeInfo]
tyvars Maybe (Context NodeInfo)
ctx ConDecl NodeInfo
d) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([TyVarBind NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TyVarBind NodeInfo]
-> Maybe [TyVarBind NodeInfo] -> [TyVarBind NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [TyVarBind NodeInfo]
tyvars))
                 (do String -> Printer ()
write String
"forall "
                     [Printer ()] -> Printer ()
spaced ((TyVarBind NodeInfo -> Printer ())
-> [TyVarBind NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ([TyVarBind NodeInfo]
-> Maybe [TyVarBind NodeInfo] -> [TyVarBind NodeInfo]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [TyVarBind NodeInfo]
tyvars))
                     String -> Printer ()
write String
". "))
         (Maybe (Context NodeInfo) -> Printer () -> Printer ()
forall (ast :: * -> *) b.
(Pretty ast, Show (ast NodeInfo)) =>
Maybe (ast NodeInfo) -> Printer b -> Printer b
withCtx Maybe (Context NodeInfo)
ctx (ConDecl NodeInfo -> Printer ()
recDecl ConDecl NodeInfo
d))

-- | Fields are preceded with a space.
conDecl :: ConDecl NodeInfo -> Printer ()
conDecl :: ConDecl NodeInfo -> Printer ()
conDecl (RecDecl NodeInfo
_ Name NodeInfo
name [FieldDecl NodeInfo]
fields) = do
   Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
   Printer ()
newline
   Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock
    (do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"{")
               (String -> [Printer ()] -> Printer ()
prefixedLined String
","
                              ((FieldDecl NodeInfo -> Printer ())
-> [FieldDecl NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (FieldDecl NodeInfo -> Printer ())
-> FieldDecl NodeInfo
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [FieldDecl NodeInfo]
fields))
        Printer ()
newline
        String -> Printer ()
write String
"}"
        )
conDecl (ConDecl NodeInfo
_ Name NodeInfo
name [Type NodeInfo]
bangty) = do
  Name NodeInfo -> Printer ()
prettyQuoteName Name NodeInfo
name
  Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    ([Type NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type NodeInfo]
bangty)
    (Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
ifFitsOnOneLineOrElse
       (do Printer ()
space
           [Printer ()] -> Printer ()
spaced ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
bangty))
       (do Printer ()
newline
           Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock ([Printer ()] -> Printer ()
lined ((Type NodeInfo -> Printer ()) -> [Type NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Type NodeInfo]
bangty))))
conDecl (InfixConDecl NodeInfo
_ Type NodeInfo
a Name NodeInfo
f Type NodeInfo
b) =
  Printer () -> [Printer ()] -> Printer ()
inter Printer ()
space [Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
a, Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
f, Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
b]

-- | Record decls are formatted like: Foo
-- { bar :: X
-- }
recDecl :: ConDecl NodeInfo -> Printer ()
recDecl :: ConDecl NodeInfo -> Printer ()
recDecl (RecDecl NodeInfo
_ Name NodeInfo
name [FieldDecl NodeInfo]
fields) =
  do Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
     Int64
indentSpaces <- Printer Int64
getIndentSpaces
     Printer ()
newline
     Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column Int64
indentSpaces
            (do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"{!")
                       (String -> [Printer ()] -> Printer ()
prefixedLined String
","
                                      ((FieldDecl NodeInfo -> Printer ())
-> [FieldDecl NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend Printer ()
space (Printer () -> Printer ())
-> (FieldDecl NodeInfo -> Printer ())
-> FieldDecl NodeInfo
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty) [FieldDecl NodeInfo]
fields))
                Printer ()
newline
                String -> Printer ()
write String
"}")
recDecl ConDecl NodeInfo
r = ConDecl NodeInfo -> Printer ()
forall (ast :: * -> *). Pretty ast => ast NodeInfo -> Printer ()
prettyInternal ConDecl NodeInfo
r

recUpdateExpr :: Printer () -> [FieldUpdate NodeInfo] -> Printer ()
recUpdateExpr :: Printer () -> [FieldUpdate NodeInfo] -> Printer ()
recUpdateExpr Printer ()
expWriter [FieldUpdate NodeInfo]
updates = do
  Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
ifFitsOnOneLineOrElse Printer ()
hor (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
    Printer ()
expWriter
    Printer ()
newline
    Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer ()
updatesHor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
updatesVer)
  where
    hor :: Printer ()
hor = do
      Printer ()
expWriter
      Printer ()
space
      Printer ()
updatesHor
    updatesHor :: Printer ()
updatesHor = Printer () -> Printer ()
forall a. Printer a -> Printer a
braces (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
commas ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (FieldUpdate NodeInfo -> Printer ())
-> [FieldUpdate NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map FieldUpdate NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [FieldUpdate NodeInfo]
updates
    updatesVer :: Printer ()
updatesVer = do
      Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write String
"{ ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined String
", " ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (FieldUpdate NodeInfo -> Printer ())
-> [FieldUpdate NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map FieldUpdate NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [FieldUpdate NodeInfo]
updates
      Printer ()
newline
      String -> Printer ()
write String
"}"

--------------------------------------------------------------------------------
-- Predicates

-- | Is the decl a record?
isRecord :: QualConDecl t -> Bool
isRecord :: QualConDecl t -> Bool
isRecord (QualConDecl t
_ Maybe [TyVarBind t]
_ Maybe (Context t)
_ RecDecl{}) = Bool
True
isRecord QualConDecl t
_ = Bool
False

-- | If the given operator is an element of line breaks in configuration.
isLineBreak :: QName NodeInfo -> Printer Bool
isLineBreak :: QName NodeInfo -> Printer Bool
isLineBreak (UnQual NodeInfo
_ (Symbol NodeInfo
_ String
s)) = do
  [String]
breaks <- (PrintState -> [String]) -> Printer [String]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Config -> [String]
configLineBreaks (Config -> [String])
-> (PrintState -> Config) -> PrintState -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintState -> Config
psConfig)
  Bool -> Printer Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Printer Bool) -> Bool -> Printer Bool
forall a b. (a -> b) -> a -> b
$ String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
breaks
isLineBreak QName NodeInfo
_ = Bool -> Printer Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Does printing the given thing overflow column limit? (e.g. 80)
fitsOnOneLine :: Printer a -> Printer (Maybe PrintState)
fitsOnOneLine :: Printer a -> Printer (Maybe PrintState)
fitsOnOneLine Printer a
p =
  do PrintState
st <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
     PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st { psFitOnOneLine :: Bool
psFitOnOneLine = Bool
True}
     Bool
ok <- (a -> Bool) -> Printer a -> Printer Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True) Printer a
p Printer Bool -> Printer Bool -> Printer Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Printer Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
     PrintState
st' <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
     PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
     Bool -> Printer ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Printer ()) -> Bool -> Printer ()
forall a b. (a -> b) -> a -> b
$ Bool
ok Bool -> Bool -> Bool
|| Bool -> Bool
not (PrintState -> Bool
psFitOnOneLine PrintState
st)
     Maybe PrintState -> Printer (Maybe PrintState)
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
ok
                then PrintState -> Maybe PrintState
forall a. a -> Maybe a
Just PrintState
st' { psFitOnOneLine :: Bool
psFitOnOneLine = PrintState -> Bool
psFitOnOneLine PrintState
st }
                else Maybe PrintState
forall a. Maybe a
Nothing)

-- | If first printer fits, use it, else use the second one.
ifFitsOnOneLineOrElse :: Printer a -> Printer a -> Printer a
ifFitsOnOneLineOrElse :: Printer a -> Printer a -> Printer a
ifFitsOnOneLineOrElse Printer a
a Printer a
b = do
  PrintState
stOrig <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
  PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
stOrig{psFitOnOneLine :: Bool
psFitOnOneLine = Bool
True}
  Maybe a
res <- (a -> Maybe a) -> Printer a -> Printer (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just Printer a
a Printer (Maybe a) -> Printer (Maybe a) -> Printer (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a -> Printer (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
  case Maybe a
res of
    Just a
r -> do
      (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((PrintState -> PrintState) -> Printer ())
-> (PrintState -> PrintState) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \PrintState
st -> PrintState
st{psFitOnOneLine :: Bool
psFitOnOneLine = PrintState -> Bool
psFitOnOneLine PrintState
stOrig}
      a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
    Maybe a
Nothing -> do
      PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
stOrig
      Bool -> Printer ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Printer ()) -> Bool -> Printer ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (PrintState -> Bool
psFitOnOneLine PrintState
stOrig)
      Printer a
b

bindingGroup :: Binds NodeInfo -> Printer ()
bindingGroup :: Binds NodeInfo -> Printer ()
bindingGroup Binds NodeInfo
binds =
  do Printer ()
newline
     Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
2
              (do String -> Printer ()
write String
"where"
                  Printer ()
newline
                  Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented Int64
2 (Binds NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Binds NodeInfo
binds))

infixApp :: Exp NodeInfo
         -> Exp NodeInfo
         -> QOp NodeInfo
         -> Exp NodeInfo
         -> Maybe Int64
         -> Printer ()
infixApp :: Exp NodeInfo
-> Exp NodeInfo
-> QOp NodeInfo
-> Exp NodeInfo
-> Maybe Int64
-> Printer ()
infixApp Exp NodeInfo
e Exp NodeInfo
a QOp NodeInfo
op Exp NodeInfo
b Maybe Int64
indent =
  Printer ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
ver
  where
    hor :: Printer ()
hor =
      [Printer ()] -> Printer ()
spaced
        [ case OpChainLink NodeInfo
link of
          OpChainExp Exp NodeInfo
e' -> Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e'
          OpChainLink QOp NodeInfo
qop -> QOp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QOp NodeInfo
qop
        | OpChainLink NodeInfo
link <- Exp NodeInfo -> [OpChainLink NodeInfo]
forall l. Exp l -> [OpChainLink l]
flattenOpChain Exp NodeInfo
e
        ]
    ver :: Printer ()
ver = do
      Exp NodeInfo -> Printer ()
prettyWithIndent Exp NodeInfo
a
      Printer ()
beforeRhs <- case Exp NodeInfo
a of
                     Do NodeInfo
_ [Stmt NodeInfo]
_ -> do
                       Int64
indentSpaces <- Printer Int64
getIndentSpaces
                       Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column (Int64 -> Maybe Int64 -> Int64
forall a. a -> Maybe a -> a
fromMaybe Int64
0 Maybe Int64
indent Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
indentSpaces Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
3) (Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QOp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QOp NodeInfo
op) -- 3 = "do "
                       Printer () -> Printer (Printer ())
forall (m :: * -> *) a. Monad m => a -> m a
return Printer ()
space
                     Exp NodeInfo
_ -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QOp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QOp NodeInfo
op Printer () -> Printer (Printer ()) -> Printer (Printer ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer (Printer ())
forall (m :: * -> *) a. Monad m => a -> m a
return Printer ()
newline
      case Exp NodeInfo
b of
        Lambda{} -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
b
        LCase{} -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
b
        Do NodeInfo
_ [Stmt NodeInfo]
stmts -> Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write String
" do") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
lined ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty [Stmt NodeInfo]
stmts)
        Exp NodeInfo
_ -> do
          Printer ()
beforeRhs
          case Maybe Int64
indent of
            Maybe Int64
Nothing -> do
              Int64
col <- (((), PrintState) -> Int64)
-> Printer ((), PrintState) -> Printer Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrintState -> Int64
psColumn (PrintState -> Int64)
-> (((), PrintState) -> PrintState) -> ((), PrintState) -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((), PrintState) -> PrintState
forall a b. (a, b) -> b
snd)
                          (Printer () -> Printer ((), PrintState)
forall a. Printer a -> Printer (a, PrintState)
sandbox (String -> Printer ()
write String
""))
              -- force indent for top-level template haskell expressions, #473.
              if Int64
col Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
                then do Int64
indentSpaces <- Printer Int64
getIndentSpaces
                        Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column Int64
indentSpaces (Exp NodeInfo -> Printer ()
prettyWithIndent Exp NodeInfo
b)
                else Exp NodeInfo -> Printer ()
prettyWithIndent Exp NodeInfo
b
            Just Int64
col -> do
              Int64
indentSpaces <- Printer Int64
getIndentSpaces
              Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
column (Int64
col Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
indentSpaces) (Exp NodeInfo -> Printer ()
prettyWithIndent Exp NodeInfo
b)
    prettyWithIndent :: Exp NodeInfo -> Printer ()
prettyWithIndent Exp NodeInfo
e' =
      case Exp NodeInfo
e' of
        InfixApp NodeInfo
_ Exp NodeInfo
a' QOp NodeInfo
op' Exp NodeInfo
b' -> Exp NodeInfo
-> Exp NodeInfo
-> QOp NodeInfo
-> Exp NodeInfo
-> Maybe Int64
-> Printer ()
infixApp Exp NodeInfo
e' Exp NodeInfo
a' QOp NodeInfo
op' Exp NodeInfo
b' Maybe Int64
indent
        Exp NodeInfo
_ -> Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e'

-- | A link in a chain of operator applications.
data OpChainLink l
  = OpChainExp (Exp l)
  | OpChainLink (QOp l)
  deriving (Int -> OpChainLink l -> String -> String
[OpChainLink l] -> String -> String
OpChainLink l -> String
(Int -> OpChainLink l -> String -> String)
-> (OpChainLink l -> String)
-> ([OpChainLink l] -> String -> String)
-> Show (OpChainLink l)
forall l. Show l => Int -> OpChainLink l -> String -> String
forall l. Show l => [OpChainLink l] -> String -> String
forall l. Show l => OpChainLink l -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [OpChainLink l] -> String -> String
$cshowList :: forall l. Show l => [OpChainLink l] -> String -> String
show :: OpChainLink l -> String
$cshow :: forall l. Show l => OpChainLink l -> String
showsPrec :: Int -> OpChainLink l -> String -> String
$cshowsPrec :: forall l. Show l => Int -> OpChainLink l -> String -> String
Show)

-- | Flatten a tree of InfixApp expressions into a chain of operator
-- links.
flattenOpChain :: Exp l -> [OpChainLink l]
flattenOpChain :: Exp l -> [OpChainLink l]
flattenOpChain (InfixApp l
_ Exp l
left QOp l
op Exp l
right) =
  Exp l -> [OpChainLink l]
forall l. Exp l -> [OpChainLink l]
flattenOpChain Exp l
left [OpChainLink l] -> [OpChainLink l] -> [OpChainLink l]
forall a. Semigroup a => a -> a -> a
<>
  [QOp l -> OpChainLink l
forall l. QOp l -> OpChainLink l
OpChainLink QOp l
op] [OpChainLink l] -> [OpChainLink l] -> [OpChainLink l]
forall a. Semigroup a => a -> a -> a
<>
  Exp l -> [OpChainLink l]
forall l. Exp l -> [OpChainLink l]
flattenOpChain Exp l
right
flattenOpChain Exp l
e = [Exp l -> OpChainLink l
forall l. Exp l -> OpChainLink l
OpChainExp Exp l
e]

-- | Write a Template Haskell quotation or a quasi-quotation.
--
-- >>> quotation "t" (string "Foo")
-- > [t|Foo|]
quotation :: String -> Printer () -> Printer ()
quotation :: String -> Printer () -> Printer ()
quotation String
quoter Printer ()
body =
  Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets
    (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
       (do String -> Printer ()
string String
quoter
           String -> Printer ()
write String
"|")
       (do Printer ()
body
           String -> Printer ()
write String
"|"))