{-# 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_, traverse_)
import           Data.Int
import           Data.List
import           Data.Monoid ((<>))
import           Data.Maybe
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 a :: ast NodeInfo
a = do
  (NodeComment -> Printer ()) -> [NodeComment] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    (\c' :: NodeComment
c' -> do
       case NodeComment
c' of
         CommentBeforeLine _ c :: SomeComment
c -> do
           case SomeComment
c of
             EndOfLine s :: String
s -> String -> Printer ()
write ("--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
             MultiLine s :: String
s -> String -> Printer ()
write ("{-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-}")
           Printer ()
newline
         _ -> () -> 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_
    (\(i :: Int
i, c' :: NodeComment
c') -> do
       case NodeComment
c' of
         CommentSameLine spn :: SrcSpan
spn c :: 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
== 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
- 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 spn :: SrcSpan
spn c :: 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
== 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
- 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
         _ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    ([Int] -> [NodeComment] -> [(Int, NodeComment)]
forall a b. [a] -> [b] -> [(a, b)]
zip [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 cs :: String
cs -> do
          String -> Printer ()
write ("--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs)
          (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
            (\s :: PrintState
s ->
                PrintState
s
                { psEolComment :: Bool
psEolComment = Bool
True
                })
        MultiLine cs :: String
cs -> do
          String -> Printer ()
write ("{-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-}")
          (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
            (\s :: 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 i :: Int64
i p :: 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 (\s :: 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 (\s :: 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 p :: 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 ", ")

-- | Print all the printers separated by sep.
inter :: Printer () -> [Printer ()] -> Printer ()
inter :: Printer () -> [Printer ()] -> Printer ()
inter sep :: Printer ()
sep ps :: [Printer ()]
ps =
  ((Int, Printer ()) -> Printer () -> Printer ())
-> Printer () -> [(Int, Printer ())] -> Printer ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    (\(i :: Int
i,p :: Printer ()
p) next :: 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 [1 ..] [Printer ()]
ps)

-- | Print all the printers separated by newlines.
lined :: [Printer ()] -> Printer ()
lined :: [Printer ()] -> Printer ()
lined ps :: [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 pref :: String
pref ps' :: [Printer ()]
ps' =
  case [Printer ()]
ps' of
    [] -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (p :: Printer ()
p:ps :: [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
*
                      (-1)))
                  ((Printer () -> Printer ()) -> [Printer ()] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\p' :: 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 i :: Int64
i p :: 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 (\s :: 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 (\s :: 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 "\n"
     (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: 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
bool pr :: 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 (\s :: 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 (\s :: 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 "->"
        else String -> Printer ()
write "="

-- | 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 maker :: Printer ()
maker dependent :: 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 open :: String
open close :: String
close p :: 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 "(" ")"

-- | 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 "{" "}"

-- | 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 "[" "]"

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

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

-- | 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 x :: 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
/= "\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
== "\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))
                               ' ') 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
> 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 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
== 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 (\s :: 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
== '\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 p :: 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 Nothing m :: Printer b
m = Printer b
m
withCtx (Just ctx :: ast NodeInfo
ctx) m :: Printer b
m =
  do ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ast NodeInfo
ctx
     String -> Printer ()
write " =>"
     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 ())
        (\p :: 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 a :: Printer ()
a b :: 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 st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
       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 i :: Int64
i a :: Printer ()
a b :: 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 _ asserts :: [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
      Nothing -> Context NodeInfo -> Printer ()
context Context NodeInfo
ctx
      Just st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
  prettyInternal ctx :: Context NodeInfo
ctx = Context NodeInfo -> Printer ()
context Context NodeInfo
ctx

instance Pretty Pat where
  prettyInternal :: Pat NodeInfo -> Printer ()
prettyInternal x :: Pat NodeInfo
x =
    case Pat NodeInfo
x of
      PLit _ sign :: Sign NodeInfo
sign l :: 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 _ n :: Name NodeInfo
n k :: 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 "+")
               (Integer -> Printer ()
int Integer
k)
      PInfixApp _ a :: Pat NodeInfo
a op :: QName NodeInfo
op b :: 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))
          _ ->
            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 _ f :: QName NodeInfo
f args :: [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 _ boxed :: Boxed
boxed pats :: [Pat NodeInfo]
pats ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write (case Boxed
boxed of
                         Unboxed -> "(# "
                         Boxed -> "("))
               (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
                            Unboxed -> " #)"
                            Boxed -> ")"))
      PList _ ps :: [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 _ e :: 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 _ qname :: QName NodeInfo
qname fields :: [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 "{}"
                  [field :: 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
                  _ -> do
                    Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "{") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
                      String -> [Printer ()] -> Printer ()
prefixedLined "," ([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 "}"
        Printer ()
horVariant Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVariant
      PAsPat _ n :: Name NodeInfo
n p :: 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 "@")
               (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
      PWildCard _ -> String -> Printer ()
write "_"
      PIrrPat _ p :: Pat NodeInfo
p ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "~")
               (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
      PatTypeSig _ p :: Pat NodeInfo
p ty :: 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 " :: ")
               (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
      PViewPat _ e :: Exp NodeInfo
e p :: 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 " -> ")
               (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
      PQuasiQuote _ name :: String
name str :: String
str -> String -> Printer () -> Printer ()
quotation String
name (String -> Printer ()
string String
str)
      PBangPat _ p :: Pat NodeInfo
p ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "!")
               (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 _ s :: Splice NodeInfo
s -> Splice NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Splice NodeInfo
s
#if MIN_VERSION_haskell_src_exts(1,20,0)
      (PUnboxedSum _ nLeft :: Int
nLeft nRight :: Int
nRight p :: Pat NodeInfo
p) -> Int -> Int -> Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
Int -> Int -> ast NodeInfo -> Printer ()
unboxedSumValuePattern Int
nLeft Int
nRight Pat NodeInfo
p
#endif

-- | Pretty infix application of a name (identifier or symbol).
prettyInfixName :: Name NodeInfo -> Printer ()
prettyInfixName :: Name NodeInfo -> Printer ()
prettyInfixName (Ident _ n :: String
n) = do String -> Printer ()
write "`"; String -> Printer ()
string String
n; String -> Printer ()
write "`";
prettyInfixName (Symbol _ s :: 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 x :: QName NodeInfo
x =
  case QName NodeInfo
x of
    Qual _ mn :: ModuleName NodeInfo
mn n :: Name NodeInfo
n ->
      case Name NodeInfo
n of
        Ident _ i :: String
i -> do String -> Printer ()
write "`"; ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
mn; String -> Printer ()
write "."; String -> Printer ()
string String
i; String -> Printer ()
write "`";
        Symbol _ s :: String
s -> do ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
mn; String -> Printer ()
write "."; String -> Printer ()
string String
s;
    UnQual _ n :: Name NodeInfo
n -> Name NodeInfo -> Printer ()
prettyInfixName Name NodeInfo
n
    Special _ s :: 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 x :: Name NodeInfo
x =
  case Name NodeInfo
x of
    Ident _ i :: String
i -> String -> Printer ()
string String
i
    Symbol _ s :: String
s -> String -> Printer ()
string ("(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")")

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 _ pats :: [Pat NodeInfo]
pats (Do l :: NodeInfo
l stmts :: [Stmt NodeInfo]
stmts)) =
  do
     Maybe PrintState
mst <-
          Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine
            (do String -> Printer ()
write "\\"
                [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 " -> "
                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
       Nothing -> Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (do String -> Printer ()
write "\\"
                            [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 " -> 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 st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
-- | Space out tuples.
exp (Tuple _ boxed :: Boxed
boxed exps :: [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 ", ") ((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 "," ((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
    Nothing -> Printer ()
verVariant
    Just st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
  where
    parensHorB :: Boxed -> Printer a -> Printer a
parensHorB Boxed = Printer a -> Printer a
forall a. Printer a -> Printer a
parens
    parensHorB Unboxed = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap "(# " " #)"
    parensVerB :: Boxed -> Printer a -> Printer a
parensVerB Boxed = Printer a -> Printer a
forall a. Printer a -> Printer a
parens
    parensVerB Unboxed = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap "(#" "#)"
-- | Space out tuples.
exp (TupleSection _ boxed :: Boxed
boxed mexps :: [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 ", ") ((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 "," ((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
    Nothing -> Printer ()
verVariant
    Just st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
  where
    parensHorB :: Boxed -> Printer a -> Printer a
parensHorB Boxed = Printer a -> Printer a
forall a. Printer a -> Printer a
parens
    parensHorB Unboxed = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap "(# " " #)"
    parensVerB :: Boxed -> Printer a -> Printer a
parensVerB Boxed = Printer a -> Printer a
forall a. Printer a -> Printer a
parens
    parensVerB Unboxed = String -> String -> Printer a -> Printer a
forall a. String -> String -> Printer a -> Printer a
wrap "(#" "#)"
#if MIN_VERSION_haskell_src_exts(1,20,0)
exp (UnboxedSum _ nLeft :: Int
nLeft nRight :: Int
nRight e :: Exp NodeInfo
e) = Int -> Int -> Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
Int -> Int -> ast NodeInfo -> Printer ()
unboxedSumValuePattern Int
nLeft Int
nRight Exp NodeInfo
e
#endif
-- | Infix apps, same algorithm as ChrisDone at the moment.
exp e :: Exp NodeInfo
e@(InfixApp _ a :: Exp NodeInfo
a op :: QOp NodeInfo
op b :: 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 _ if' :: Exp NodeInfo
if' then' :: Exp NodeInfo
then' else' :: Exp NodeInfo
else') =
  do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "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 "then " Exp NodeInfo
then'
                  Printer ()
newline
                  String -> Exp NodeInfo -> Printer ()
branch "else " Exp NodeInfo
else')
     -- Special handling for do.
  where branch :: String -> Exp NodeInfo -> Printer ()
branch str :: String
str e :: Exp NodeInfo
e =
          case Exp NodeInfo
e of
            Do _ stmts :: [Stmt NodeInfo]
stmts ->
              do String -> Printer ()
write String
str
                 String -> Printer ()
write "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))
            _ ->
              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 _ op :: Exp NodeInfo
op arg :: 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
    Nothing -> do
      let (f :: Exp NodeInfo
f:args :: [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
== 0 then Int64
spaces else 0
      if Int64
diff Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ 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 st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
  where
    flatten :: Exp NodeInfo -> [Exp NodeInfo]
flatten (App label' :: NodeInfo
label' op' :: Exp NodeInfo
op' arg' :: 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 x :: Exp NodeInfo
x = [Exp NodeInfo
x]
    addComments :: NodeInfo -> NodeInfo -> NodeInfo
addComments n1 :: NodeInfo
n1 n2 :: 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 _ es :: [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
       Nothing -> do
         Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
           (String -> Printer ()
write "[")
           (String -> [Printer ()] -> Printer ()
prefixedLined "," ((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 "]"
       Just st :: 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 ", ")
                          ((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 _ exp' :: Exp NodeInfo
exp' updates :: [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 _ qname :: QName NodeInfo
qname updates :: [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 _ binds :: Binds NodeInfo
binds e :: Exp NodeInfo
e) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "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 (-3) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "in ")
                                   (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)))
exp (ListComp _ e :: Exp NodeInfo
e qstmt :: [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 " | "
        [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 "[ "
        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 "| ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined ", " ([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 "]"
  Printer ()
horVariant Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVariant

exp (ParComp _ e :: Exp NodeInfo
e qstmts :: [[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
$ \qstmt :: [QualStmt NodeInfo]
qstmt -> do
          String -> Printer ()
write " | "
          [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 "[ ") (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
$ \qstmt :: [QualStmt NodeInfo]
qstmt -> do
          Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "| ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined ", " ([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 "]"
  Printer ()
horVariant Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
`ifFitsOnOneLineOrElse` Printer ()
verVariant

exp (TypeApp _ t :: Type NodeInfo
t) = do
  String -> Printer ()
write "@"
  Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
t
exp (NegApp _ e :: Exp NodeInfo
e) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "-")
         (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
exp (Lambda _ ps :: [Pat NodeInfo]
ps e :: Exp NodeInfo
e) = do
  String -> Printer ()
write "\\"
  [Printer ()] -> Printer ()
spaced [ do case (Int
i, Pat NodeInfo
x) of
                (0, PIrrPat {}) -> Printer ()
space
                (0, PBangPat {}) -> Printer ()
space
                _ -> () -> 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
         | (i :: Int
i, x :: Pat NodeInfo
x) <- [Int] -> [Pat NodeInfo] -> [(Int, Pat NodeInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0 :: Int ..] [Pat NodeInfo]
ps
         ]
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write " ->") (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 _ e :: 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 _ e :: Exp NodeInfo
e alts :: [Alt NodeInfo]
alts) =
  do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "case ")
            (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
                String -> Printer ()
write " of")
     if [Alt NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt NodeInfo]
alts
       then String -> Printer ()
write " {}"
       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 _ stmts :: [Stmt NodeInfo]
stmts) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "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 _ stmts :: [Stmt NodeInfo]
stmts) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "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 _ e :: Exp NodeInfo
e op :: 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 _ e :: QOp NodeInfo
e op :: 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 _ e :: 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 " ..")
exp (EnumFromTo _ e :: Exp NodeInfo
e f :: 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 " .. ")
                   (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
f))
exp (EnumFromThen _ e :: Exp NodeInfo
e t :: 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 ",")
                   (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
t
                       String -> Printer ()
write " .."))
exp (EnumFromThenTo _ e :: Exp NodeInfo
e t :: Exp NodeInfo
t f :: 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 ",")
                   (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 " .. ")
                           (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
f)))
exp (ExpTypeSig _ e :: Exp NodeInfo
e t :: 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 " :: ")
         (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
t)
exp (VarQuote _ x :: QName NodeInfo
x) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "'")
         (QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
x)
exp (TypQuote _ x :: QName NodeInfo
x) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "''")
         (QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
x)
exp (BracketExp _ b :: Bracket NodeInfo
b) = Bracket NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Bracket NodeInfo
b
exp (SpliceExp _ s :: Splice NodeInfo
s) = Splice NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Splice NodeInfo
s
exp (QuasiQuote _ n :: String
n s :: String
s) = String -> Printer () -> Printer ()
quotation String
n (String -> Printer ()
string String
s)
exp (LCase _ alts :: [Alt NodeInfo]
alts) =
  do String -> Printer ()
write "\\case"
     if [Alt NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt NodeInfo]
alts
       then String -> Printer ()
write " {}"
       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 _ alts :: [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 "if ")
       ([Printer ()] -> Printer ()
lined
          ((GuardedRhs NodeInfo -> Printer ())
-> [GuardedRhs NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map
             (\p :: GuardedRhs NodeInfo
p -> do
                String -> Printer ()
write "| "
                GuardedRhs NodeInfo -> Printer ()
prettyG GuardedRhs NodeInfo
p)
             [GuardedRhs NodeInfo]
alts)))
  where
    prettyG :: GuardedRhs NodeInfo -> Printer ()
prettyG (GuardedRhs _ stmts :: [Stmt NodeInfo]
stmts e :: Exp NodeInfo
e) = do
      Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented
        1
        (do ([Printer ()] -> Printer ()
lined (((Int, Stmt NodeInfo) -> Printer ())
-> [(Int, Stmt NodeInfo)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map
                         (\(i :: Int
i,p :: 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
== 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 ","))
                         ([Int] -> [Stmt NodeInfo] -> [(Int, Stmt NodeInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..] [Stmt NodeInfo]
stmts))))
      Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write " " 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 _ lit :: Literal NodeInfo
lit) = Literal NodeInfo -> Printer ()
forall (ast :: * -> *). Pretty ast => ast NodeInfo -> Printer ()
prettyInternal Literal NodeInfo
lit
exp (Var _ q :: QName NodeInfo
q) = QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
q
exp (IPVar _ q :: IPName NodeInfo
q) = IPName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty IPName NodeInfo
q
exp (Con _ q :: 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 _ label :: String
label) = String -> Printer ()
string ('#' 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 x :: QualStmt NodeInfo
x =
    case QualStmt NodeInfo
x of
      QualStmt _ s :: Stmt NodeInfo
s -> Stmt NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Stmt NodeInfo
s
      ThenTrans _ s :: Exp NodeInfo
s -> do
        String -> Printer ()
write "then "
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
      ThenBy _ s :: Exp NodeInfo
s t :: Exp NodeInfo
t -> do
        String -> Printer ()
write "then "
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
        String -> Printer ()
write " by "
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
t
      GroupBy _ s :: Exp NodeInfo
s -> do
        String -> Printer ()
write "then group by "
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
      GroupUsing _ s :: Exp NodeInfo
s -> do
        String -> Printer ()
write "then group using "
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
      GroupByUsing _ s :: Exp NodeInfo
s t :: Exp NodeInfo
t -> do
        String -> Printer ()
write "then group by "
        Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
s
        String -> Printer ()
write " 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 _ moverlap :: Maybe (Overlap NodeInfo)
moverlap dhead :: InstRule NodeInfo
dhead decls :: Maybe [InstDecl NodeInfo]
decls) =
  do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "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 " 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 _ e :: Exp NodeInfo
e) = Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
decl (TypeSig _ names :: [Name NodeInfo]
names ty :: Type NodeInfo
ty) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write ", ")
                   ((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 " :: ")
         (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
decl (FunBind _ matches :: [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 _ ctx :: Maybe (Context NodeInfo)
ctx dhead :: DeclHead NodeInfo
dhead fundeps :: [FunDep NodeInfo]
fundeps decls :: 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 _ typehead :: DeclHead NodeInfo
typehead typ' :: Type NodeInfo
typ') = do
  String -> Printer ()
write "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 " = ") (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 " = ") (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
typ')))
decl (TypeFamDecl _ declhead :: DeclHead NodeInfo
declhead result :: Maybe (ResultSig NodeInfo)
result injectivity :: Maybe (InjectivityInfo NodeInfo)
injectivity) = do
  String -> Printer ()
write "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 r :: ResultSig NodeInfo
r -> do
      Printer ()
space
      let sep :: String
sep = case ResultSig NodeInfo
r of
                  KindSig _ _ -> "::"
                  TyVarSig _ _ -> "="
      String -> Printer ()
write String
sep
      Printer ()
space
      ResultSig NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ResultSig NodeInfo
r
    Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  case Maybe (InjectivityInfo NodeInfo)
injectivity of
    Just i :: InjectivityInfo NodeInfo
i -> do
      Printer ()
space
      InjectivityInfo NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InjectivityInfo NodeInfo
i
    Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
decl (ClosedTypeFamDecl _ declhead :: DeclHead NodeInfo
declhead result :: Maybe (ResultSig NodeInfo)
result injectivity :: Maybe (InjectivityInfo NodeInfo)
injectivity instances :: [TypeEqn NodeInfo]
instances) = do
  String -> Printer ()
write "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
$ \r :: ResultSig NodeInfo
r -> do
    Printer ()
space
    let sep :: String
sep = case ResultSig NodeInfo
r of
                KindSig _ _ -> "::"
                TyVarSig _ _ -> "="
    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
$ \i :: 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 "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 _ dataornew :: DataOrNew NodeInfo
dataornew ctx :: Maybe (Context NodeInfo)
ctx dhead :: DeclHead NodeInfo
dhead condecls :: [QualConDecl NodeInfo]
condecls mderivs :: [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 ()
                           [x :: QualConDecl NodeInfo
x] -> QualConDecl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
singleCons QualConDecl NodeInfo
x
                           xs :: [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
$ \deriv :: 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 x :: ast NodeInfo
x =
          do String -> Printer ()
write " ="
             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 xs :: [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 -> [Printer ()] -> Printer ()
prefixedLined "|"
                                           ((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 _ dataornew :: DataOrNew NodeInfo
dataornew ctx :: Maybe (Context NodeInfo)
ctx dhead :: DeclHead NodeInfo
dhead mkind :: Maybe (Type NodeInfo)
mkind condecls :: [GadtDecl NodeInfo]
condecls mderivs :: [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
               Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
               Just kind :: Type NodeInfo
kind -> do String -> Printer ()
write " :: "
                               Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
             String -> Printer ()
write " 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 ()
         _ -> 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
$ \deriv :: 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 _ inline :: Bool
inline active :: Maybe (Activation NodeInfo)
active name :: QName NodeInfo
name) = do
  String -> Printer ()
write "{-# "

  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 "NO"
  String -> Printer ()
write "INLINE "
  case Maybe (Activation NodeInfo)
active of
    Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (ActiveFrom _ x :: Int
x) -> String -> Printer ()
write ("[" 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]
++ "] ")
    Just (ActiveUntil _ x :: Int
x) -> String -> Printer ()
write ("[~" 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]
++ "] ")
  QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
name

  String -> Printer ()
write " #-}"
decl (MinimalPragma _ (Just formula :: BooleanFormula NodeInfo
formula)) =
  String -> String -> Printer () -> Printer ()
forall a. String -> String -> Printer a -> Printer a
wrap "{-# " " #-}" (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 "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 _ callconv :: CallConv NodeInfo
callconv maybeSafety :: Maybe (Safety NodeInfo)
maybeSafety maybeName :: Maybe String
maybeName name :: Name NodeInfo
name ty :: Type NodeInfo
ty) = do
  String -> Printer ()
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 :: 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
    Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  case Maybe String
maybeName of
    Just namestr :: 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
    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 " :: "
                               Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
  case Maybe PrintState
tyline of
    Just line :: PrintState
line -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
line
    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 ":: "
                                     Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
decl (ForExp _ callconv :: CallConv NodeInfo
callconv maybeName :: Maybe String
maybeName name :: Name NodeInfo
name ty :: Type NodeInfo
ty) = do
  String -> Printer ()
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 namestr :: 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
    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 " :: "
                               Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
  case Maybe PrintState
tyline of
    Just line :: PrintState
line -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
line
    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 ":: "
                                     Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Type NodeInfo
ty
decl x' :: 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 ctx :: Maybe (Context NodeInfo)
ctx dhead :: DeclHead NodeInfo
dhead fundeps :: [FunDep NodeInfo]
fundeps decls :: 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 "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 " | " 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 " where"))))
    longHead :: Printer ()
longHead = do
      Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "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 -> [Printer ()] -> Printer ()
prefixedLined ", " ([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 "where")

instance Pretty TypeEqn where
  prettyInternal :: TypeEqn NodeInfo -> Printer ()
prettyInternal (TypeEqn _ in_ :: Type NodeInfo
in_ out_ :: Type NodeInfo
out_) = do
    Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
in_
    String -> Printer ()
write " = "
    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 _ strategy :: Maybe (DerivStrategy NodeInfo)
strategy heads :: [InstRule NodeInfo]
heads) =
    Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "deriving" 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
$
    case Maybe (DerivStrategy NodeInfo)
strategy of
      Nothing -> Printer ()
printHeads
#if MIN_VERSION_haskell_src_exts(1,21,0)
      Just st :: DerivStrategy NodeInfo
st@(DerivVia _ _) -> Printer ()
printHeads 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
>> DerivStrategy NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty DerivStrategy NodeInfo
st
#endif
      Just st :: DerivStrategy NodeInfo
st -> Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (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) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
printHeads
    where
      printHeads :: Printer ()
printHeads = 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
== 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
          Nothing -> [InstRule NodeInfo] -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
[ast NodeInfo] -> Printer ()
formatMultiLine [InstRule NodeInfo]
heads'
          Just derives :: PrintState
derives -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
derives
      stripParens :: InstRule l -> InstRule l
stripParens (IParen _ iRule :: InstRule l
iRule) = InstRule l -> InstRule l
stripParens InstRule l
iRule
      stripParens x :: InstRule l
x = InstRule l
x
      formatMultiLine :: [ast NodeInfo] -> Printer ()
formatMultiLine derives :: [ast NodeInfo]
derives = do
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "( ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined ", " ((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 ")"

instance Pretty DerivStrategy where
  prettyInternal :: DerivStrategy NodeInfo -> Printer ()
prettyInternal x :: DerivStrategy NodeInfo
x =
    case DerivStrategy NodeInfo
x of
      DerivStock _ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      DerivAnyclass _ -> String -> Printer ()
write "anyclass"
      DerivNewtype _ -> String -> Printer ()
write "newtype"
#if MIN_VERSION_haskell_src_exts(1,21,0)
      DerivVia _ t :: Type NodeInfo
t -> Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "via" 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
$ Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
t
#endif

instance Pretty Alt where
  prettyInternal :: Alt NodeInfo -> Printer ()
prettyInternal x :: Alt NodeInfo
x =
    case Alt NodeInfo
x of
      Alt _ p :: Pat NodeInfo
p galts :: Rhs NodeInfo
galts mbinds :: 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
             Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             Just binds :: 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 "where ")
                                (Binds NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Binds NodeInfo
binds))

#if MIN_VERSION_haskell_src_exts(1,22,0)
instance Pretty Asst where
  prettyInternal :: Asst NodeInfo -> Printer ()
prettyInternal x :: Asst NodeInfo
x =
    case Asst NodeInfo
x of
      ParenA _ asst :: Asst NodeInfo
asst -> Printer () -> Printer ()
forall a. Printer a -> Printer a
parens (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Asst NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Asst NodeInfo
asst
      IParam _ name :: IPName NodeInfo
name ty :: Type NodeInfo
ty -> IPName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty IPName NodeInfo
name Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
write " :: " 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
ty
      TypeA _ ty :: Type NodeInfo
ty -> Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty
#else
instance Pretty Asst where
  prettyInternal x =
    case x of
      ClassA _ name types -> spaced (pretty name : map pretty types)
      i@InfixA {} -> pretty' i
      IParam _ name ty -> do
        pretty name
        write " :: "
        pretty ty
      EqualP _ a b -> do
        pretty a
        write " ~ "
        pretty b
      ParenA _ asst -> parens (pretty asst)
      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 x :: BangType NodeInfo
x =
    case BangType NodeInfo
x of
      BangedTy _ -> String -> Printer ()
write "!"
      LazyTy _ -> String -> Printer ()
write "~"
      NoStrictAnnot _ -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance Pretty Binds where
  prettyInternal :: Binds NodeInfo -> Printer ()
prettyInternal x :: Binds NodeInfo
x =
    case Binds NodeInfo
x of
      BDecls _ ds :: [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 _ i :: [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 x :: ClassDecl NodeInfo
x =
    case ClassDecl NodeInfo
x of
      ClsDecl _ d :: Decl NodeInfo
d -> Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
d
      ClsDataFam _ ctx :: Maybe (Context NodeInfo)
ctx h :: DeclHead NodeInfo
h mkind :: Maybe (ResultSig NodeInfo)
mkind ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
          (String -> Printer ()
write "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
                    Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    Just kind :: ResultSig NodeInfo
kind -> do
                      String -> Printer ()
write " :: "
                      ResultSig NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ResultSig NodeInfo
kind)))
      ClsTyFam _ h :: DeclHead NodeInfo
h msig :: Maybe (ResultSig NodeInfo)
msig minj :: Maybe (InjectivityInfo NodeInfo)
minj ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
          (String -> Printer ()
write "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 _ kind :: Type NodeInfo
kind -> String -> Printer ()
write " :: " 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 _ tyVarBind :: TyVarBind NodeInfo
tyVarBind -> String -> Printer ()
write " = " 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_ (\inj :: 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 _ (TypeEqn _ this :: Type NodeInfo
this that :: Type NodeInfo
that) -> do
        String -> Printer ()
write "type "
        Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
this
        String -> Printer ()
write " = "
        Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
that
      ClsDefSig _ name :: Name NodeInfo
name ty :: Type NodeInfo
ty -> do
        String -> Printer ()
write "default "
        Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
        String -> Printer ()
write " :: "
        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 x :: ConDecl NodeInfo
x =
    ConDecl NodeInfo -> Printer ()
conDecl ConDecl NodeInfo
x

instance Pretty FieldDecl where
  prettyInternal :: FieldDecl NodeInfo -> Printer ()
prettyInternal (FieldDecl _ names :: [Name NodeInfo]
names ty :: 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 " :: ")
           (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 x :: FieldUpdate NodeInfo
x =
    case FieldUpdate NodeInfo
x of
      FieldUpdate _ n :: QName NodeInfo
n e :: 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 " =")
               (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
      FieldPun _ n :: QName NodeInfo
n -> QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
n
      FieldWildcard _ -> String -> Printer ()
write ".."

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

instance Pretty InjectivityInfo where
  prettyInternal :: InjectivityInfo NodeInfo -> Printer ()
prettyInternal x :: 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 i :: InstDecl NodeInfo
i =
    case InstDecl NodeInfo
i of
      InsDecl _ d :: Decl NodeInfo
d -> Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
d
      InsType _ name :: Type NodeInfo
name ty :: Type NodeInfo
ty ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do String -> Printer ()
write "type "
                   Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
name
                   String -> Printer ()
write " = ")
               (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
      _ -> 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 x :: PatField NodeInfo
x =
    case PatField NodeInfo
x of
      PFieldPat _ n :: QName NodeInfo
n p :: 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 " = ")
               (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
      PFieldPun _ n :: QName NodeInfo
n -> QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
n
      PFieldWildcard _ -> String -> Printer ()
write ".."

instance Pretty QualConDecl where
  prettyInternal :: QualConDecl NodeInfo -> Printer ()
prettyInternal x :: QualConDecl NodeInfo
x =
    case QualConDecl NodeInfo
x of
      QualConDecl _ tyvars :: Maybe [TyVarBind NodeInfo]
tyvars ctx :: Maybe (Context NodeInfo)
ctx d :: 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 "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 ". "))
               (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 _ name :: Name NodeInfo
name _ _ fields :: Maybe [FieldDecl NodeInfo]
fields t :: 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' p :: 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 ()
          fs :: [FieldDecl NodeInfo]
fs -> do
            Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "{") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
              String -> [Printer ()] -> Printer ()
prefixedLined "," ((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 "}"
            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 " :: ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
          Printer () -> Printer ()
fields' (String -> Printer ()
write " -> ")
          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 ":: ") (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 (-3) (String -> Printer ()
write "-> ")
            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 x :: Splice NodeInfo
x =
    case Splice NodeInfo
x of
      IdSplice _ str :: String
str ->
        do String -> Printer ()
write "$"
           String -> Printer ()
string String
str
#if MIN_VERSION_haskell_src_exts(1,22,0)
      TIdSplice _ str :: String
str ->
        do String -> Printer ()
write "$$"
           String -> Printer ()
string String
str
#endif
      ParenSplice _ e :: Exp NodeInfo
e ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "$")
               (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))
#if MIN_VERSION_haskell_src_exts(1,22,0)
      TParenSplice _ e :: Exp NodeInfo
e ->
        Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "$$")
               (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))
#endif

instance Pretty InstRule where
  prettyInternal :: InstRule NodeInfo -> Printer ()
prettyInternal (IParen _ rule :: 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 _ mvarbinds :: Maybe [TyVarBind NodeInfo]
mvarbinds mctx :: Maybe (Context NodeInfo)
mctx ihead :: InstHead NodeInfo
ihead) =
    do case Maybe [TyVarBind NodeInfo]
mvarbinds of
         Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         Just xs :: [TyVarBind NodeInfo]
xs -> do String -> Printer ()
write "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 ". "
       case Maybe (Context NodeInfo)
mctx of
         Nothing -> InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
ihead
         Just ctx :: 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 " => "
                                    InstHead NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty InstHead NodeInfo
ihead
                                    String -> Printer ()
write " where")
           case Maybe PrintState
mst of
             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 " => "
               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 x :: InstHead NodeInfo
x =
    case InstHead NodeInfo
x of
      -- Base cases
      IHCon _ name :: QName NodeInfo
name -> QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
name
      IHInfix _ typ' :: Type NodeInfo
typ' name :: 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 _ ihead :: InstHead NodeInfo
ihead typ' :: 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 _ h :: 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 x :: DeclHead NodeInfo
x =
    case DeclHead NodeInfo
x of
      DHead _ name :: Name NodeInfo
name -> Name NodeInfo -> Printer ()
prettyQuoteName Name NodeInfo
name
      DHParen _ h :: 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 _ var :: TyVarBind NodeInfo
var name :: 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 _ dhead :: DeclHead NodeInfo
dhead var :: 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 _) = String -> Printer ()
write "{-# OVERLAP #-}"
  prettyInternal (Overlapping _) = String -> Printer ()
write "{-# OVERLAPPING #-}"
  prettyInternal (Overlaps _) = String -> Printer ()
write "{-# OVERLAPS #-}"
  prettyInternal (Overlappable _) = String -> Printer ()
write "{-# OVERLAPPABLE #-}"
  prettyInternal (NoOverlap _) = String -> Printer ()
write "{-# NO_OVERLAP #-}"
  prettyInternal (Incoherent _) = String -> Printer ()
write "{-# INCOHERENT #-}"

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

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 x :: Module NodeInfo
x =
    case Module NodeInfo
x of
      Module _ mayModHead :: Maybe (ModuleHead NodeInfo)
mayModHead pragmas :: [ModulePragma NodeInfo]
pragmas imps :: [ImportDecl NodeInfo]
imps decls :: [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 (\(isNull :: Bool
isNull,r :: 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
                               Nothing -> (Bool
True,() -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                               Just modHead :: 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{} -> (1,Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
r)
                                             r :: Decl NodeInfo
r@InlineSig{} -> (1, Decl NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Decl NodeInfo
r)
                                             r :: Decl NodeInfo
r -> (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 i :: m a
i ((c :: Int
c,p :: m ()
p):ps :: [(Int, m ())]
ps) =
                case [(Int, m ())]
ps of
                  [] -> m ()
p
                  _ ->
                    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 ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      XmlPage{} -> String -> Printer ()
forall a. HasCallStack => String -> a
error "FIXME: No implementation for XmlPage."
      XmlHybrid{} -> String -> Printer ()
forall a. HasCallStack => String -> a
error "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 import1 :: ast NodeInfo
import1 import2 :: 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
<= 1
    formatImportGroup :: [ImportDecl NodeInfo] -> Printer ()
formatImportGroup imps :: [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 idecl :: ImportDecl l
idecl =
      let ModuleName _ name :: 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 imps :: [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 imp :: 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
l hiding :: Bool
hiding specs :: [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 l2 :: l
l2 name :: Name l
name cNames :: [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 is :: ImportSpec l
is = ImportSpec l
is

groupAdjacentBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupAdjacentBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupAdjacentBy _ [] = []
groupAdjacentBy adj :: a -> a -> Bool
adj items :: [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
    (xs :: [a]
xs, rest :: [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 _ [] = ([], [])
spanAdjacentBy _ [x :: a
x] = ([a
x], [])
spanAdjacentBy adj :: a -> a -> Bool
adj (x :: a
x:xs :: [a]
xs@(y :: a
y:_))
  | a -> a -> Bool
adj a
x a
y =
    let (xs' :: [a]
xs', rest' :: [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 _ _ (Ident _ s1 :: String
s1)) (IAbs _ _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs _ _ (Ident _ _)) (IAbs _ _ (Symbol _ _)) = Ordering
GT
importSpecCompare (IAbs _ _ (Ident _ s1 :: String
s1)) (IThingAll _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs _ _ (Ident _ _)) (IThingAll _ (Symbol _ _)) = Ordering
GT
importSpecCompare (IAbs _ _ (Ident _ s1 :: String
s1)) (IThingWith _ (Ident _ s2 :: String
s2) _) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs _ _ (Ident _ _)) (IThingWith _ (Symbol _ _) _) = Ordering
GT
importSpecCompare (IAbs _ _ (Symbol _ _)) (IAbs _ _ (Ident _ _)) = Ordering
LT
importSpecCompare (IAbs _ _ (Symbol _ s1 :: String
s1)) (IAbs _ _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs _ _ (Symbol _ _)) (IThingAll _ (Ident _ _)) = Ordering
LT
importSpecCompare (IAbs _ _ (Symbol _ s1 :: String
s1)) (IThingAll _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs _ _ (Symbol _ _)) (IThingWith _ (Ident _ _) _) = Ordering
LT
importSpecCompare (IAbs _ _ (Symbol _ s1 :: String
s1)) (IThingWith _ (Symbol _ s2 :: String
s2) _) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IAbs _ _ _) (IVar _ _) = Ordering
LT
importSpecCompare (IThingAll _ (Ident _ s1 :: String
s1)) (IAbs _ _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll _ (Ident _ _)) (IAbs _ _ (Symbol _ _)) = Ordering
GT
importSpecCompare (IThingAll _ (Ident _ s1 :: String
s1)) (IThingAll _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll _ (Ident _ _)) (IThingAll _ (Symbol _ _)) = Ordering
GT
importSpecCompare (IThingAll _ (Ident _ s1 :: String
s1)) (IThingWith _ (Ident _ s2 :: String
s2) _) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll _ (Ident _ _)) (IThingWith _ (Symbol _ _) _) = Ordering
GT
importSpecCompare (IThingAll _ (Symbol _ _)) (IAbs _ _ (Ident _ _)) = Ordering
LT
importSpecCompare (IThingAll _ (Symbol _ s1 :: String
s1)) (IAbs _ _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll _ (Symbol _ _)) (IThingAll _ (Ident _ _)) = Ordering
LT
importSpecCompare (IThingAll _ (Symbol _ s1 :: String
s1)) (IThingAll _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll _ (Symbol _ _)) (IThingWith _ (Ident _ _) _) = Ordering
LT
importSpecCompare (IThingAll _ (Symbol _ s1 :: String
s1)) (IThingWith _ (Symbol _ s2 :: String
s2) _) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingAll _ _) (IVar _ _) = Ordering
LT
importSpecCompare (IThingWith _ (Ident _ s1 :: String
s1) _) (IAbs _ _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith _ (Ident _ _) _) (IAbs _ _ (Symbol _ _)) = Ordering
GT
importSpecCompare (IThingWith _ (Ident _ s1 :: String
s1) _) (IThingAll _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith _ (Ident _ _) _) (IThingAll _ (Symbol _ _)) = Ordering
GT
importSpecCompare (IThingWith _ (Ident _ s1 :: String
s1) _) (IThingWith _ (Ident _ s2 :: String
s2) _) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith _ (Ident _ _) _) (IThingWith _ (Symbol _ _) _) = Ordering
GT
importSpecCompare (IThingWith _ (Symbol _ _) _) (IAbs _ _ (Ident _ _)) = Ordering
LT
importSpecCompare (IThingWith _ (Symbol _ s1 :: String
s1) _) (IAbs _ _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith _ (Symbol _ _) _) (IThingAll _ (Ident _ _)) = Ordering
LT
importSpecCompare (IThingWith _ (Symbol _ s1 :: String
s1) _) (IThingAll _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith _ (Symbol _ _) _) (IThingWith _ (Ident _ _) _) = Ordering
LT
importSpecCompare (IThingWith _ (Symbol _ s1 :: String
s1) _) (IThingWith _ (Symbol _ s2 :: String
s2) _) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IThingWith _ _ _) (IVar _ _) = Ordering
LT
importSpecCompare (IVar _ (Ident _ s1 :: String
s1)) (IVar _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IVar _ (Ident _ _)) (IVar _ (Symbol _ _)) = Ordering
GT
importSpecCompare (IVar _ (Symbol _ _)) (IVar _ (Ident _ _)) = Ordering
LT
importSpecCompare (IVar _ (Symbol _ s1 :: String
s1)) (IVar _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
importSpecCompare (IVar _ _) _ = Ordering
GT

cNameCompare :: CName l -> CName l -> Ordering
cNameCompare :: CName l -> CName l -> Ordering
cNameCompare (VarName _ (Ident _ s1 :: String
s1)) (VarName _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (VarName _ (Ident _ _)) (VarName _ (Symbol _ _)) = Ordering
GT
cNameCompare (VarName _ (Ident _ s1 :: String
s1)) (ConName _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (VarName _ (Ident _ _)) (ConName _ (Symbol _ _)) = Ordering
GT
cNameCompare (VarName _ (Symbol _ _)) (VarName _ (Ident _ _)) = Ordering
LT
cNameCompare (VarName _ (Symbol _ s1 :: String
s1)) (VarName _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (VarName _ (Symbol _ _)) (ConName _ (Ident _ _)) = Ordering
LT
cNameCompare (VarName _ (Symbol _ s1 :: String
s1)) (ConName _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (ConName _ (Ident _ s1 :: String
s1)) (VarName _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (ConName _ (Ident _ _)) (VarName _ (Symbol _ _)) = Ordering
GT
cNameCompare (ConName _ (Ident _ s1 :: String
s1)) (ConName _ (Ident _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (ConName _ (Ident _ _)) (ConName _ (Symbol _ _)) = Ordering
GT
cNameCompare (ConName _ (Symbol _ _)) (VarName _ (Ident _ _)) = Ordering
LT
cNameCompare (ConName _ (Symbol _ s1 :: String
s1)) (VarName _ (Symbol _ s2 :: String
s2)) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
s1 String
s2
cNameCompare (ConName _ (Symbol _ _)) (ConName _ (Ident _ _)) = Ordering
LT
cNameCompare (ConName _ (Symbol _ s1 :: String
s1)) (ConName _ (Symbol _ s2 :: 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 x :: Bracket NodeInfo
x =
    case Bracket NodeInfo
x of
      ExpBracket _ p :: Exp NodeInfo
p -> String -> Printer () -> Printer ()
quotation "" (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
p)
#if MIN_VERSION_haskell_src_exts(1,22,0)
      TExpBracket _ p :: Exp NodeInfo
p ->
        Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets
          (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend
             (String -> Printer ()
write "||")
             (do Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
p
                 String -> Printer ()
write "||"))
#endif
      PatBracket _ p :: Pat NodeInfo
p -> String -> Printer () -> Printer ()
quotation "p" (Pat NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Pat NodeInfo
p)
      TypeBracket _ ty :: Type NodeInfo
ty -> String -> Printer () -> Printer ()
quotation "t" (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
ty)
      d :: Bracket NodeInfo
d@(DeclBracket _ _) -> 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 x :: IPBind NodeInfo
x =
    case IPBind NodeInfo
x of
      IPBind _ name :: IPName NodeInfo
name expr :: 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 "="
        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 _ i :: Name NodeInfo
i@(Ident _ _)) = Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Name NodeInfo
i
  prettyInternal (VarFormula _ (Symbol _ s :: String
s)) = String -> Printer ()
write "(" 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 ")"
  prettyInternal (AndFormula _ fs :: [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 ", ") ([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
        Nothing -> String -> [Printer ()] -> Printer ()
prefixedLined ", " ((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 formulas :: PrintState
formulas -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
formulas
  prettyInternal (OrFormula _ fs :: [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 " | ") ([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
        Nothing -> String -> [Printer ()] -> Printer ()
prefixedLined "| " ((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 formulas :: PrintState
formulas -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
formulas
  prettyInternal (ParenFormula _ f :: 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 _ kind :: Type NodeInfo
kind) = Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
kind
  prettyInternal (TyVarSig _ tyVarBind :: 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 _ _ rep :: String
rep) = do
    String -> Printer ()
write "\""
    String -> Printer ()
string String
rep
    String -> Printer ()
write "\""
  prettyInternal (Char _ _ rep :: String
rep) = do
    String -> Printer ()
write "'"
    String -> Printer ()
string String
rep
    String -> Printer ()
write "'"
  prettyInternal (PrimString _ _ rep :: String
rep) = do
    String -> Printer ()
write "\""
    String -> Printer ()
string String
rep
    String -> Printer ()
write "\"#"
  prettyInternal (PrimChar _ _ rep :: String
rep) = do
    String -> Printer ()
write "'"
    String -> Printer ()
string String
rep
    String -> Printer ()
write "'#"
  -- We print the original notation (because HSE doesn't track Hex
  -- vs binary vs decimal notation).
  prettyInternal (Int _l :: NodeInfo
_l _i :: Integer
_i originalString :: String
originalString) =
    String -> Printer ()
string String
originalString
  prettyInternal (Frac _l :: NodeInfo
_l _r :: Rational
_r originalString :: String
originalString) =
    String -> Printer ()
string String
originalString
  prettyInternal x :: 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 x :: Name NodeInfo
x = case Name NodeInfo
x of
                          Ident _ _ -> Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Pretty (ast SrcSpanInfo)) =>
ast NodeInfo -> Printer ()
pretty' Name NodeInfo
x -- Identifiers.
                          Symbol _ s :: String
s -> String -> Printer ()
string String
s -- Symbols

instance Pretty QName where
  prettyInternal :: QName NodeInfo -> Printer ()
prettyInternal =
    \case
      Qual _ mn :: ModuleName NodeInfo
mn n :: Name NodeInfo
n ->
        case Name NodeInfo
n of
          Ident _ i :: String
i -> do ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
mn; String -> Printer ()
write "."; String -> Printer ()
string String
i;
          Symbol _ s :: String
s -> do String -> Printer ()
write "("; ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
mn; String -> Printer ()
write "."; String -> Printer ()
string String
s; String -> Printer ()
write ")";
      UnQual _ n :: Name NodeInfo
n ->
        case Name NodeInfo
n of
          Ident _ i :: String
i -> String -> Printer ()
string String
i
          Symbol _ s :: String
s -> do String -> Printer ()
write "("; String -> Printer ()
string String
s; String -> Printer ()
write ")";
      Special _ 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 _ 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 _ s :: 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 s :: SpecialCon NodeInfo
s =
    case SpecialCon NodeInfo
s of
      UnitCon _ -> String -> Printer ()
write "()"
      ListCon _ -> String -> Printer ()
write "[]"
      FunCon _ -> String -> Printer ()
write "->"
      TupleCon _ Boxed i :: Int
i ->
        String -> Printer ()
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
- 1) ',' String -> String -> String
forall a. [a] -> [a] -> [a]
++
                ")")
      TupleCon _ Unboxed i :: Int
i ->
        String -> Printer ()
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
- 1) ',' String -> String -> String
forall a. [a] -> [a] -> [a]
++
                " #)")
      Cons _ -> String -> Printer ()
write ":"
      UnboxedSingleCon _ -> String -> Printer ()
write "(##)"
      ExprHole _ -> String -> Printer ()
write "_"

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 _ name :: ModuleName NodeInfo
name mwarnings :: Maybe (WarningText NodeInfo)
mwarnings mexports :: Maybe (ExportSpecList NodeInfo)
mexports) =
    do String -> Printer ()
write "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 ())
             (\exports :: 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 " 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 _ name :: ModuleName NodeInfo
name qualified :: Bool
qualified source :: Bool
source safe :: Bool
safe mpkg :: Maybe String
mpkg mas :: Maybe (ModuleName NodeInfo)
mas mspec :: Maybe (ImportSpecList NodeInfo)
mspec) = do
    String -> Printer ()
write "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 " {-# 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 " 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 " qualified"
    case Maybe String
mpkg of
      Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just pkg :: 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
forall a. [a] -> [a] -> [a]
++ String
pkg String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\"")
    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
      Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just asName :: ModuleName NodeInfo
asName -> do
        Printer ()
space
        String -> Printer ()
write "as "
        ModuleName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ModuleName NodeInfo
asName
    case Maybe (ImportSpecList NodeInfo)
mspec of
      Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just spec :: 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 _ name :: String
name) =
    String -> Printer ()
write String
name

instance Pretty ImportSpecList where
  prettyInternal :: ImportSpecList NodeInfo -> Printer ()
prettyInternal (ImportSpecList _ hiding :: Bool
hiding spec :: [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 " 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 -> [Printer ()] -> Printer ()
prefixedLined ", " ((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 ")")
    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 _ s :: String
s) =
    String -> Printer ()
write "{-# 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 " #-}"
  prettyInternal (WarnText _ s :: String
s) =
    String -> Printer ()
write "{-# 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 " #-}"

instance Pretty ExportSpecList where
  prettyInternal :: ExportSpecList NodeInfo -> Printer ()
prettyInternal (ExportSpecList _ es :: [ExportSpec NodeInfo]
es) = do
    Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "(")
           (String -> [Printer ()] -> Printer ()
prefixedLined "," ((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 ")"

instance Pretty ExportSpec where
  prettyInternal :: ExportSpec NodeInfo -> Printer ()
prettyInternal x :: ExportSpec NodeInfo
x = String -> Printer ()
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 _ e :: Exp NodeInfo
e@(InfixApp _ a :: Exp NodeInfo
a op :: QOp NodeInfo
op b :: 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 ""))
     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 _ p :: Pat NodeInfo
p e :: 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 " <-")
                 Printer ()
space
                 Exp NodeInfo
e
                 Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty)
stmt x :: Stmt NodeInfo
x = case Stmt NodeInfo
x of
           Generator _ p :: Pat NodeInfo
p e :: 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 " <- ")
                    (Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
           Qualifier _ e :: Exp NodeInfo
e -> Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e
           LetStmt _ binds :: Binds NodeInfo
binds ->
             Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "let ")
                    (Binds NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Binds NodeInfo
binds)
           RecStmt _ es :: [Stmt NodeInfo]
es ->
             Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "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 left :: Printer ()
left prefix :: Printer ()
prefix right :: Exp NodeInfo
right f :: 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
       Nothing -> do Printer ()
left
                     Printer ()
newline
                     (Exp NodeInfo -> Printer ()
f Exp NodeInfo
right)
       Just st :: 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 _ (Do _ dos :: [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 " -> " else " = ")
     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 2 Int64
indentSpaces
     Int64 -> Printer () -> Printer () -> Printer ()
forall b. Int64 -> Printer () -> Printer b -> Printer b
swingBy Int64
indentation
             (String -> Printer ()
write "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 _ e :: Exp NodeInfo
e) = do
  Maybe PrintState
msg <-
    Printer () -> Printer (Maybe PrintState)
forall a. Printer a -> Printer (Maybe PrintState)
fitsOnOneLine
      (do String -> Printer ()
write " "
          Printer ()
rhsSeparator
          String -> Printer ()
write " "
          Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
  case Maybe PrintState
msg of
    Nothing -> Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write " " 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 st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
rhs (GuardedRhss _ gas :: [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 (\p :: GuardedRhs NodeInfo
p ->
                             do String -> Printer ()
write "|"
                                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 _ stmts :: [Stmt NodeInfo]
stmts (Do _ dos :: [Stmt NodeInfo]
dos)) =
  do Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented 1
              (do String -> [Printer ()] -> Printer ()
prefixedLined
                    ","
                    ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map (\p :: 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 " -> " else " = ")
     Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write "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 _ stmts :: [Stmt NodeInfo]
stmts e :: 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 st :: 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 " "
                Printer ()
rhsSeparator
                String -> Printer ()
write " "
                Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e)
        case Maybe PrintState
mst' of
          Just st' :: PrintState
st' -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st'
          Nothing -> Printer ()
swingIt
      Nothing -> do
        Printer ()
printStmts
        Printer ()
swingIt
  where
    printStmts :: Printer ()
printStmts =
      Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented
        1
        (do String -> [Printer ()] -> Printer ()
prefixedLined
              ","
              ((Stmt NodeInfo -> Printer ()) -> [Stmt NodeInfo] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map
                 (\p :: 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 " " 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 _ name :: Name NodeInfo
name pats :: [Pat NodeInfo]
pats rhs' :: Rhs NodeInfo
rhs' mbinds :: Maybe (Binds NodeInfo)
mbinds) =
  do Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (do case Name NodeInfo
name of
                  Ident _ _ ->
                    Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
                  Symbol _ _ ->
                    do String -> Printer ()
write "("
                       Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
name
                       String -> Printer ()
write ")"
                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 _ pat1 :: Pat NodeInfo
pat1 name :: Name NodeInfo
name pats :: [Pat NodeInfo]
pats rhs' :: Rhs NodeInfo
rhs' mbinds :: 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 ctx :: Context NodeInfo
ctx =
  case Context NodeInfo
ctx of
    CxSingle _ a :: Asst NodeInfo
a -> Asst NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Asst NodeInfo
a
    CxTuple _ as :: [Asst NodeInfo]
as -> do
      Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "( ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined ", " ((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 ")"
    CxEmpty _ -> 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 _ Boxed types :: [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 ", ") ((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 "," ((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 _ Unboxed types :: [Type NodeInfo]
types) = do
  let horVar :: Printer ()
horVar = String -> String -> Printer () -> Printer ()
forall a. String -> String -> Printer a -> Printer a
wrap "(# " " #)" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write ", ") ((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 "(#" " #)" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined "," ((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 _ mbinds :: Maybe [TyVarBind NodeInfo]
mbinds ctx :: Maybe (Context NodeInfo)
ctx ty :: Type NodeInfo
ty) =
  Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (case Maybe [TyVarBind NodeInfo]
mbinds of
            Nothing -> () -> Printer ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just ts :: [TyVarBind NodeInfo]
ts ->
              do String -> Printer ()
write "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 ". ")
         (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 _ a :: Type NodeInfo
a b :: 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 " -> ")
         (Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
b)
typ (TyList _ t :: 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 _ t :: Type NodeInfo
t) =
  Printer () -> Printer ()
forall a. Printer a -> Printer a
brackets (do String -> Printer ()
write ":"
               Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
t
               String -> Printer ()
write ":")
typ (TyApp _ f :: Type NodeInfo
f a :: 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 _ n :: Name NodeInfo
n) = Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
n
typ (TyCon _ p :: QName NodeInfo
p) = QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
p
typ (TyParen _ e :: 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 _ a :: Type NodeInfo
a promotedop :: MaybePromotedName NodeInfo
promotedop b :: Type NodeInfo
b) = do
  -- Apply special rules to line-break operators.
  let isLineBreak' :: MaybePromotedName NodeInfo -> Printer Bool
isLineBreak' op :: MaybePromotedName NodeInfo
op =
        case MaybePromotedName NodeInfo
op of
          PromotedName _ op' :: QName NodeInfo
op' -> QName NodeInfo -> Printer Bool
isLineBreak QName NodeInfo
op'
          UnpromotedName _ op' :: QName NodeInfo
op' -> QName NodeInfo -> Printer Bool
isLineBreak QName NodeInfo
op'
      prettyInfixOp' :: MaybePromotedName NodeInfo -> Printer ()
prettyInfixOp' op :: MaybePromotedName NodeInfo
op =
        case MaybePromotedName NodeInfo
op of
          PromotedName _ op' :: QName NodeInfo
op' -> String -> Printer ()
write "'" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName NodeInfo -> Printer ()
prettyInfixOp QName NodeInfo
op'
          UnpromotedName _ op' :: 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 _ ty :: Type NodeInfo
ty k :: 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 " :: "
             Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
k)
typ (TyBang _ bangty :: BangType NodeInfo
bangty unpackty :: Unpackedness NodeInfo
unpackty right :: 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 _ left :: Type NodeInfo
left right :: Type NodeInfo
right) =
  do Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
left
     String -> Printer ()
write " ~ "
     Type NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Type NodeInfo
right
typ (TyPromoted _ (PromotedList _ _ ts :: [Type NodeInfo]
ts)) =
  do String -> Printer ()
write "'["
     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 " "
     [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 "]"
typ (TyPromoted _ (PromotedTuple _ ts :: [Type NodeInfo]
ts)) =
  do String -> Printer ()
write "'("
     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 " "
     [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 ")"
typ (TyPromoted _ (PromotedCon _ _ tname :: QName NodeInfo
tname)) =
  do String -> Printer ()
write "'"
     QName NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty QName NodeInfo
tname
typ (TyPromoted _ (PromotedString _ _ raw :: String
raw)) = do
  do String -> Printer ()
write "\""
     String -> Printer ()
string String
raw
     String -> Printer ()
write "\""
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 _ splice :: Splice NodeInfo
splice) = Splice NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Splice NodeInfo
splice
typ (TyWildCard _ name :: Maybe (Name NodeInfo)
name) =
  case Maybe (Name NodeInfo)
name of
    Nothing -> String -> Printer ()
write "_"
    Just n :: Name NodeInfo
n ->
      do String -> Printer ()
write "_"
         Name NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Name NodeInfo
n
typ (TyQuasiQuote _ n :: String
n s :: String
s) = String -> Printer () -> Printer ()
quotation String
n (String -> Printer ()
string String
s)
#if MIN_VERSION_haskell_src_exts(1,20,0)
typ (TyUnboxedSum _ types :: [Type NodeInfo]
types) = do
  let horVar :: Printer ()
horVar = String -> String -> Printer () -> Printer ()
forall a. String -> String -> Printer a -> Printer a
wrap "(# " " #)" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
inter (String -> Printer ()
write " | ") ((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 "(# " " #)" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined "|" ((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
#endif
#if MIN_VERSION_haskell_src_exts(1,21,0)
typ (TyStar _) = String -> Printer ()
write "*"
#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 _ names :: [Name NodeInfo]
names ty' :: 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 " :: ")
                               (Type NodeInfo -> Printer ()
declTy Type NodeInfo
ty'))
  case Maybe PrintState
mst of
    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 " ::"
                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 "   ") (Type NodeInfo -> Printer ()
declTy Type NodeInfo
ty'))
        else (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write " :: ") (Type NodeInfo -> Printer ()
declTy Type NodeInfo
ty'))
    Just st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
  where
    nameLength :: Name l -> Int
nameLength (Ident _ s :: String
s) = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
    nameLength (Symbol _ s :: 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
+ 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
+ 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
- 1)

decl' (PatBind _ pat :: Pat NodeInfo
pat rhs' :: Rhs NodeInfo
rhs' mbinds :: 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' e :: Decl NodeInfo
e = Decl NodeInfo -> Printer ()
decl Decl NodeInfo
e

declTy :: Type NodeInfo -> Printer ()
declTy :: Type NodeInfo -> Printer ()
declTy dty :: Type NodeInfo
dty =
  case Type NodeInfo
dty of
    TyForall _ mbinds :: Maybe [TyVarBind NodeInfo]
mbinds mctx :: Maybe (Context NodeInfo)
mctx ty :: Type NodeInfo
ty ->
      case Maybe [TyVarBind NodeInfo]
mbinds of
        Nothing -> do
          case Maybe (Context NodeInfo)
mctx of
            Nothing -> Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
False Type NodeInfo
ty
            Just ctx :: 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 " => ") (Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
False Type NodeInfo
ty))
              case Maybe PrintState
mst of
                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 (-3) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "=> ") (Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
True Type NodeInfo
ty))
                Just st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
        Just ts :: [TyVarBind NodeInfo]
ts -> do
          String -> Printer ()
write "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 "."
          case Maybe (Context NodeInfo)
mctx of
            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
                Nothing -> do
                  Printer ()
newline
                  Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
True Type NodeInfo
ty
                Just st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st
            Just ctx :: 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
                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 (-3) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "=> ") (Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
True Type NodeInfo
ty))
                Just st :: 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 (-3) (Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer b
depend (String -> Printer ()
write "=> ") (Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
True Type NodeInfo
ty))
    _ -> Bool -> Type NodeInfo -> Printer ()
prettyTy Bool
False Type NodeInfo
dty
  where
    collapseFaps :: Type l -> [Type l]
collapseFaps (TyFun _ arg :: Type l
arg result :: 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 e :: Type l
e = [Type l
e]
    prettyTy :: Bool -> Type NodeInfo -> Printer ()
prettyTy breakLine :: Bool
breakLine ty :: 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
            tys :: [Type NodeInfo]
tys -> String -> [Printer ()] -> Printer ()
prefixedLined "-> " ((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
            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
                tys :: [Type NodeInfo]
tys -> String -> [Printer ()] -> Printer ()
prefixedLined "-> " ((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 st :: PrintState
st -> PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
st

-- | Fields are preceded with a space.
conDecl :: ConDecl NodeInfo -> Printer ()
conDecl :: ConDecl NodeInfo -> Printer ()
conDecl (RecDecl _ name :: Name NodeInfo
name fields :: [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 -> [Printer ()] -> Printer ()
prefixedLined ","
                              ((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 "}"
        )
conDecl (ConDecl _ name :: Name NodeInfo
name bangty :: [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 _ a :: Type NodeInfo
a f :: Name NodeInfo
f b :: 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]

recUpdateExpr :: Printer () -> [FieldUpdate NodeInfo] -> Printer ()
recUpdateExpr :: Printer () -> [FieldUpdate NodeInfo] -> Printer ()
recUpdateExpr expWriter :: Printer ()
expWriter updates :: [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 "{ ") (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> [Printer ()] -> Printer ()
prefixedLined ", " ([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 "}"

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

-- | If the given operator is an element of line breaks in configuration.
isLineBreak :: QName NodeInfo -> Printer Bool
isLineBreak :: QName NodeInfo -> Printer Bool
isLineBreak (UnQual _ (Symbol _ s :: 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 _ = 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 p :: 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 a :: Printer a
a b :: 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 r :: 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
$ \st :: 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
    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 :: Binds NodeInfo
binds =
  do Printer ()
newline
     Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented 2
              (do String -> Printer ()
write "where"
                  Printer ()
newline
                  Int64 -> Printer () -> Printer ()
forall a. Int64 -> Printer a -> Printer a
indented 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 e :: Exp NodeInfo
e a :: Exp NodeInfo
a op :: QOp NodeInfo
op b :: Exp NodeInfo
b indent :: 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 e' :: Exp NodeInfo
e' -> Exp NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty Exp NodeInfo
e'
          OpChainLink qop :: 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 _ _ -> 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 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
+ 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
                     _ -> 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 _ stmts :: [Stmt NodeInfo]
stmts -> Printer () -> Printer () -> Printer ()
forall b. Printer () -> Printer b -> Printer ()
swing (String -> Printer ()
write " 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)
        _ -> do
          Printer ()
beforeRhs
          case Maybe Int64
indent of
            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 ""))
              -- force indent for top-level template haskell expressions, #473.
              if Int64
col Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== 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 col :: 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 e' :: Exp NodeInfo
e' =
      case Exp NodeInfo
e' of
        InfixApp _ a' :: Exp NodeInfo
a' op' :: QOp NodeInfo
op' b' :: 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 -> 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 _ left :: Exp l
left op :: QOp l
op right :: 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 e :: 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 quoter :: String
quoter body :: 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 "|")
       (do Printer ()
body
           String -> Printer ()
write "|"))

-- | Write an UnboxedSum value/pattern.
--
-- >>> unboxedSumValuePattern 0 1 (Var  (UnQual  (Ident  "n")))
-- (# n | #)
-- >>> unboxedSumValuePattern 0 1 (PTuple  Unboxed [PVar  (Ident  "n"),PWildCard ])
-- (# (# n, _ #) | #)
-- >>> unboxedSumValuePattern 1 0 (PVar  (Ident  "b"))
-- (# | b #)
-- >>> unboxedSumValuePattern 1 0 (Var  (UnQual  (Ident  "b")))
-- (# | b #)
unboxedSumValuePattern
  :: (Pretty ast, Show (ast NodeInfo))
  => Int
  -- ^ Number of types from the left.
  -> Int
  -- ^ Number of types from the right.
  -> ast NodeInfo
  -- ^ Value/Pattern.
  -> Printer ()
  -- ^ UnboxedSum Printer.
unboxedSumValuePattern :: Int -> Int -> ast NodeInfo -> Printer ()
unboxedSumValuePattern nLeft :: Int
nLeft nRight :: Int
nRight e :: ast NodeInfo
e = do
  String -> String -> Printer () -> Printer ()
forall a. String -> String -> Printer a -> Printer a
wrap "(# " " #)" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
    Int -> Printer () -> Printer ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
nLeft (String -> Printer ()
write "| ")
    ast NodeInfo -> Printer ()
forall (ast :: * -> *).
(Pretty ast, Show (ast NodeInfo)) =>
ast NodeInfo -> Printer ()
pretty ast NodeInfo
e
    Int -> Printer () -> Printer ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
nRight (String -> Printer ()
write " |")