{-# LANGUAGE OverloadedStrings #-}

module Floskell.Printers
    ( getConfig
    , getOption
    , cut
    , closeEolComment
    , oneline
    , ignoreOneline
      -- * Basic printing
    , write
    , string
    , int
    , space
    , newline
    , ensureNewline
    , blankline
    , spaceOrNewline
      -- * Tab stops
    , withTabStops
    , atTabStop
      -- * Combinators
    , mayM_
    , withPrefix
    , withPostfix
    , withIndentConfig
    , withIndent
    , withIndentFlex
    , withIndentAfter
    , withIndentBy
    , withLayout
    , inter
      -- * Indentation
    , getNextColumn
    , column
    , aligned
    , indented
    , onside
    , suppressOnside
    , depend
    , depend'
    , parens
    , brackets
      -- * Wrapping
    , group
    , groupH
    , groupV
      -- * Operators
    , operator
    , operatorH
    , operatorV
    , alignOnOperator
    , withOperatorFormatting
    , withOperatorFormattingH
    , withOperatorFormattingV
    , operatorSectionL
    , operatorSectionR
    , comma
    ) where

import           Control.Applicative        ( (<|>) )
import           Control.Monad              ( guard, unless, when )
import           Control.Monad.Search       ( cost, winner )
import           Control.Monad.State.Strict ( get, gets, modify )

import           Data.List                  ( intersperse )
import qualified Data.Map.Strict            as Map
import           Data.Monoid                ( (<>) )
import           Data.Text                  ( Text )
import qualified Data.Text                  as T

import qualified Floskell.Buffer            as Buffer
import           Floskell.Config
import           Floskell.Types

-- | Query part of the pretty printer config
getConfig :: (Config -> b) -> Printer b
getConfig :: forall b. (Config -> b) -> Printer b
getConfig Config -> b
f = Config -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Config
psConfig

-- | Query pretty printer options
getOption :: (OptionConfig -> a) -> Printer a
getOption :: forall a. (OptionConfig -> a) -> Printer a
getOption OptionConfig -> a
f = forall b. (Config -> b) -> Printer b
getConfig (OptionConfig -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> OptionConfig
cfgOptions)

-- | Line penalty calculation
linePenalty :: Bool -> Int -> Printer Penalty
linePenalty :: Bool -> Int -> Printer Penalty
linePenalty Bool
eol Int
col = do
    Int
indentLevel <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int
psIndentLevel
    PenaltyConfig
config <- forall b. (Config -> b) -> Printer b
getConfig Config -> PenaltyConfig
cfgPenalty
    let maxcol :: Int
maxcol = PenaltyConfig -> Int
penaltyMaxLineLength PenaltyConfig
config
    let pLinebreak :: Int
pLinebreak = forall {p}. Num p => Bool -> p -> p
onlyIf Bool
eol forall a b. (a -> b) -> a -> b
$ PenaltyConfig -> Int
penaltyLinebreak PenaltyConfig
config
    let pIndent :: Int
pIndent = Int
indentLevel forall a. Num a => a -> a -> a
* PenaltyConfig -> Int
penaltyIndent PenaltyConfig
config
    let pOverfull :: Int
pOverfull = forall {p}. Num p => Bool -> p -> p
onlyIf (Int
col forall a. Ord a => a -> a -> Bool
> Int
maxcol) forall a b. (a -> b) -> a -> b
$ PenaltyConfig -> Int
penaltyOverfull PenaltyConfig
config
            forall a. Num a => a -> a -> a
* (Int
col forall a. Num a => a -> a -> a
- Int
maxcol) forall a. Num a => a -> a -> a
+ PenaltyConfig -> Int
penaltyOverfullOnce PenaltyConfig
config
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Penalty
Penalty forall a b. (a -> b) -> a -> b
$ Int
pLinebreak forall a. Num a => a -> a -> a
+ Int
pIndent forall a. Num a => a -> a -> a
+ Int
pOverfull
  where
    onlyIf :: Bool -> p -> p
onlyIf Bool
cond p
penalty = if Bool
cond then p
penalty else p
0

-- | Try only the first (i.e. locally best) solution to the given
-- pretty printer.  Use this function to improve performance whenever
-- the formatting of an AST node has no effect on the penalty of any
-- following AST node, such as top-level declarations or case
-- branches.
cut :: Printer a -> Printer a
cut :: forall a. Printer a -> Printer a
cut = forall c (m :: * -> *) a. MonadSearch c m => m a -> m a
winner

closeEolComment :: Printer ()
closeEolComment :: Printer ()
closeEolComment = do
    Bool
eol <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psEolComment
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
eol Printer ()
newline

withOutputRestriction :: OutputRestriction -> Printer a -> Printer a
withOutputRestriction :: forall a. OutputRestriction -> Printer a -> Printer a
withOutputRestriction OutputRestriction
r Printer a
p = do
    OutputRestriction
orig <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> OutputRestriction
psOutputRestriction
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PrintState
s -> PrintState
s { psOutputRestriction :: OutputRestriction
psOutputRestriction = OutputRestriction
r }
    a
result <- Printer a
p
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PrintState
s -> PrintState
s { psOutputRestriction :: OutputRestriction
psOutputRestriction = OutputRestriction
orig }
    forall (m :: * -> *) a. Monad m => a -> m a
return a
result

oneline :: Printer a -> Printer a
oneline :: forall a. Printer a -> Printer a
oneline Printer a
p = do
    Printer ()
closeEolComment
    forall a. OutputRestriction -> Printer a -> Printer a
withOutputRestriction OutputRestriction
NoOverflowOrLinebreak Printer a
p

ignoreOneline :: Printer a -> Printer a
ignoreOneline :: forall a. Printer a -> Printer a
ignoreOneline = forall a. OutputRestriction -> Printer a -> Printer a
withOutputRestriction OutputRestriction
Anything

-- | Write out a string, updating the current position information.
write :: Text -> Printer ()
write :: Text -> Printer ()
write Text
x = do
    Printer ()
closeEolComment
    Text -> Printer ()
write' Text
x
  where
    write' :: Text -> Printer ()
write' Text
x' = do
        PrintState
state <- forall s (m :: * -> *). MonadState s m => m s
get
        let indentLevel :: Int
indentLevel = PrintState -> Int
psIndentLevel PrintState
state
            out :: Text
out = if PrintState -> Bool
psNewline PrintState
state
                  then Int -> Text -> Text
T.replicate Int
indentLevel Text
" " forall a. Semigroup a => a -> a -> a
<> Text
x'
                  else Text
x'
            buffer :: Buffer
buffer = PrintState -> Buffer
psBuffer PrintState
state
            newCol :: Int
newCol = Buffer -> Int
Buffer.column Buffer
buffer forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
out
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ PrintState -> OutputRestriction
psOutputRestriction PrintState
state forall a. Eq a => a -> a -> Bool
== OutputRestriction
Anything Bool -> Bool -> Bool
|| Int
newCol
            forall a. Ord a => a -> a -> Bool
< PenaltyConfig -> Int
penaltyMaxLineLength (Config -> PenaltyConfig
cfgPenalty (PrintState -> Config
psConfig PrintState
state))
        Penalty
penalty <- Bool -> Int -> Printer Penalty
linePenalty Bool
False Int
newCol
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Penalty
penalty forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *). MonadSearch c m => c -> c -> m ()
cost forall a. Monoid a => a
mempty Penalty
penalty
        forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s ->
                PrintState
s { psBuffer :: Buffer
psBuffer = Text -> Buffer -> Buffer
Buffer.write Text
out Buffer
buffer, psEolComment :: Bool
psEolComment = Bool
False })

-- | Write a string.
string :: String -> Printer ()
string :: String -> Printer ()
string = Text -> Printer ()
write forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

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

-- | Write a space.
space :: Printer ()
space :: Printer ()
space = do
    Bool
comment <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psEolComment
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
comment forall a b. (a -> b) -> a -> b
$ Text -> Printer ()
write Text
" "

-- | Output a newline.
newline :: Printer ()
newline :: Printer ()
newline = do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s ->
            PrintState
s { psIndentLevel :: Int
psIndentLevel = PrintState -> Int
psIndentLevel PrintState
s forall a. Num a => a -> a -> a
+ PrintState -> Int
psOnside PrintState
s, psOnside :: Int
psOnside = Int
0 })
    PrintState
state <- forall s (m :: * -> *). MonadState s m => m s
get
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ PrintState -> OutputRestriction
psOutputRestriction PrintState
state forall a. Eq a => a -> a -> Bool
/= OutputRestriction
NoOverflowOrLinebreak
    Penalty
penalty <- Bool -> Int -> Printer Penalty
linePenalty Bool
True (PrintState -> Int
psColumn PrintState
state)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Penalty
penalty forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *). MonadSearch c m => c -> c -> m ()
cost Penalty
penalty forall a. Monoid a => a
mempty
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s { psBuffer :: Buffer
psBuffer     = Buffer -> Buffer
Buffer.newline (PrintState -> Buffer
psBuffer PrintState
state)
                    , psEolComment :: Bool
psEolComment = Bool
False
                    })

-- | Output a newline if not at the start of a line
ensureNewline :: Printer ()
ensureNewline :: Printer ()
ensureNewline = do
    Bool
nl <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psNewline
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
nl Printer ()
newline

blankline :: Printer ()
blankline :: Printer ()
blankline = Printer ()
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
newline

spaceOrNewline :: Printer ()
spaceOrNewline :: Printer ()
spaceOrNewline = Printer ()
space forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Printer ()
newline

withTabStops :: [(TabStop, Maybe Int)] -> Printer a -> Printer a
withTabStops :: forall a. [(TabStop, Maybe Int)] -> Printer a -> Printer a
withTabStops [(TabStop, Maybe Int)]
stops Printer a
p = do
    Int
col <- Printer Int
getNextColumn
    Map TabStop Int
oldstops <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Map TabStop Int
psTabStops
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PrintState
s ->
        PrintState
s { psTabStops :: Map TabStop Int
psTabStops =
                forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(TabStop
k, Maybe Int
v) -> forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
x -> Int
col forall a. Num a => a -> a -> a
+ Int
x) Maybe Int
v) TabStop
k)
                      (PrintState -> Map TabStop Int
psTabStops PrintState
s)
                      [(TabStop, Maybe Int)]
stops
          }
    a
res <- Printer a
p
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PrintState
s -> PrintState
s { psTabStops :: Map TabStop Int
psTabStops = Map TabStop Int
oldstops }
    forall (m :: * -> *) a. Monad m => a -> m a
return a
res

atTabStop :: TabStop -> Printer ()
atTabStop :: TabStop -> Printer ()
atTabStop TabStop
tabstop = do
    Maybe Int
mstop <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TabStop
tabstop forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintState -> Map TabStop Int
psTabStops)
    forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe Int
mstop forall a b. (a -> b) -> a -> b
$ \Int
stop -> do
        Int
col <- Printer Int
getNextColumn
        let padding :: Int
padding = forall a. Ord a => a -> a -> a
max Int
0 (Int
stop forall a. Num a => a -> a -> a
- Int
col)
        Text -> Printer ()
write (Int -> Text -> Text
T.replicate Int
padding Text
" ")

mayM_ :: Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ :: forall a. Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe a
Nothing a -> Printer ()
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
mayM_ (Just a
x) a -> Printer ()
p = a -> Printer ()
p a
x

withPrefix :: Applicative f => f a -> (x -> f b) -> x -> f b
withPrefix :: forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPrefix f a
pre x -> f b
f x
x = f a
pre forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> x -> f b
f x
x

withPostfix :: Applicative f => f a -> (x -> f b) -> x -> f b
withPostfix :: forall (f :: * -> *) a x b.
Applicative f =>
f a -> (x -> f b) -> x -> f b
withPostfix f a
post x -> f b
f x
x = x -> f b
f x
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* f a
post

withIndentConfig
    :: (IndentConfig -> Indent) -> Printer a -> (Int -> Printer a) -> Printer a
withIndentConfig :: forall a.
(IndentConfig -> Indent)
-> Printer a -> (Int -> Printer a) -> Printer a
withIndentConfig IndentConfig -> Indent
fn Printer a
align Int -> Printer a
indentby = do
    Indent
cfg <- forall b. (Config -> b) -> Printer b
getConfig (IndentConfig -> Indent
fn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> IndentConfig
cfgIndent)
    case Indent
cfg of
        Indent
Align -> Printer a
align
        IndentBy Int
i -> Int -> Printer a
indentby Int
i
        AlignOrIndentBy Int
i -> Printer a
align forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Printer a
indentby Int
i

withIndent :: (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent :: forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
fn Printer a
p = forall a.
(IndentConfig -> Indent)
-> Printer a -> (Int -> Printer a) -> Printer a
withIndentConfig IndentConfig -> Indent
fn Printer a
align Int -> Printer a
indentby
  where
    align :: Printer a
align = do
        Printer ()
space
        forall a. Printer a -> Printer a
aligned Printer a
p

    indentby :: Int -> Printer a
indentby Int
i = forall a. Int -> Printer a -> Printer a
indented Int
i forall a b. (a -> b) -> a -> b
$ do
        Printer ()
newline
        Printer a
p

withIndentFlex :: (IndentConfig -> Indent) -> Printer a -> Printer a
withIndentFlex :: forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndentFlex IndentConfig -> Indent
fn Printer a
p = forall a.
(IndentConfig -> Indent)
-> Printer a -> (Int -> Printer a) -> Printer a
withIndentConfig IndentConfig -> Indent
fn Printer a
align Int -> Printer a
indentby
  where
    align :: Printer a
align = do
        Printer ()
space
        forall a. Printer a -> Printer a
aligned Printer a
p

    indentby :: Int -> Printer a
indentby Int
i = forall a. Int -> Printer a -> Printer a
indented Int
i forall a b. (a -> b) -> a -> b
$ do
        Printer ()
spaceOrNewline
        Printer a
p

withIndentAfter
    :: (IndentConfig -> Indent) -> Printer () -> Printer a -> Printer a
withIndentAfter :: forall a.
(IndentConfig -> Indent) -> Printer () -> Printer a -> Printer a
withIndentAfter IndentConfig -> Indent
fn Printer ()
before Printer a
p = forall a.
(IndentConfig -> Indent)
-> Printer a -> (Int -> Printer a) -> Printer a
withIndentConfig IndentConfig -> Indent
fn Printer a
align Int -> Printer a
indentby
  where
    align :: Printer a
align = forall a. Printer a -> Printer a
aligned forall a b. (a -> b) -> a -> b
$ do
        forall a. ((Int, Int) -> (Int, Int)) -> Printer a -> Printer a
withIndentation forall a. a -> a
id Printer ()
before
        Printer a
p

    indentby :: Int -> Printer a
indentby Int
i = do
        forall a. ((Int, Int) -> (Int, Int)) -> Printer a -> Printer a
withIndentation forall a. a -> a
id Printer ()
before
        forall a. Int -> Printer a -> Printer a
indented Int
i Printer a
p

withIndentBy :: (IndentConfig -> Int) -> Printer a -> Printer a
withIndentBy :: forall a. (IndentConfig -> Int) -> Printer a -> Printer a
withIndentBy IndentConfig -> Int
fn = forall a. (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent (Int -> Indent
IndentBy forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndentConfig -> Int
fn)

withLayout :: (LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout :: forall a.
(LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
fn Printer a
flex Printer a
vertical = do
    Layout
cfg <- forall b. (Config -> b) -> Printer b
getConfig (LayoutConfig -> Layout
fn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> LayoutConfig
cfgLayout)
    case Layout
cfg of
        Layout
Flex -> Printer a
flex
        Layout
Vertical -> Printer a
vertical
        Layout
TryOneline -> forall a. Printer a -> Printer a
oneline Printer a
flex forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Printer a
vertical

inter :: Printer () -> [Printer ()] -> Printer ()
inter :: Printer () -> [Printer ()] -> Printer ()
inter Printer ()
x = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Printer ()
x

-- | Get the column for the next printed character.
getNextColumn :: Printer Int
getNextColumn :: Printer Int
getNextColumn = do
    PrintState
st <- forall s (m :: * -> *). MonadState s m => m s
get
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if PrintState -> Bool
psEolComment PrintState
st
             then PrintState -> Int
psIndentLevel PrintState
st forall a. Num a => a -> a -> a
+ PrintState -> Int
psOnside PrintState
st
             else forall a. Ord a => a -> a -> a
max (PrintState -> Int
psColumn PrintState
st) (PrintState -> Int
psIndentLevel PrintState
st)

withIndentation :: ((Int, Int) -> (Int, Int)) -> Printer a -> Printer a
withIndentation :: forall a. ((Int, Int) -> (Int, Int)) -> Printer a -> Printer a
withIndentation (Int, Int) -> (Int, Int)
f Printer a
p = do
    Int
prevIndent <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int
psIndentLevel
    Int
prevOnside <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int
psOnside
    let (Int
newIndent, Int
newOnside) = (Int, Int) -> (Int, Int)
f (Int
prevIndent, Int
prevOnside)
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s { psIndentLevel :: Int
psIndentLevel = Int
newIndent, psOnside :: Int
psOnside = Int
newOnside })
    a
r <- Printer a
p
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s { psIndentLevel :: Int
psIndentLevel = Int
prevIndent, psOnside :: Int
psOnside = Int
prevOnside })
    forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | Set the (newline-) indent level to the given column for the given
-- printer.
column :: Int -> Printer a -> Printer a
column :: forall a. Int -> Printer a -> Printer a
column Int
i = forall a. ((Int, Int) -> (Int, Int)) -> Printer a -> Printer a
withIndentation forall a b. (a -> b) -> a -> b
$ \(Int
l, Int
o) -> (Int
i, if Int
i forall a. Ord a => a -> a -> Bool
> Int
l then Int
0 else Int
o)

aligned :: Printer a -> Printer a
aligned :: forall a. Printer a -> Printer a
aligned Printer a
p = do
    Int
col <- Printer Int
getNextColumn
    forall a. Int -> Printer a -> Printer a
column Int
col Printer a
p

-- | Increase indentation level by n spaces for the given printer.
indented :: Int -> Printer a -> Printer a
indented :: forall a. Int -> Printer a -> Printer a
indented Int
i Printer a
p = do
    Int
level <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int
psIndentLevel
    forall a. Int -> Printer a -> Printer a
column (Int
level forall a. Num a => a -> a -> a
+ Int
i) Printer a
p

-- | Increase indentation level by n spaces for the given printer, but
-- ignore increase when computing further indentations.
onside :: Printer a -> Printer a
onside :: forall a. Printer a -> Printer a
onside Printer a
p = do
    Printer ()
closeEolComment
    Int
onsideIndent <- forall b. (Config -> b) -> Printer b
getConfig (IndentConfig -> Int
cfgIndentOnside forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> IndentConfig
cfgIndent)
    forall a. ((Int, Int) -> (Int, Int)) -> Printer a -> Printer a
withIndentation (\(Int
l, Int
_) -> (Int
l, Int
onsideIndent)) Printer a
p

-- | Temporarily ignore any onside identation.
suppressOnside :: Printer () -> Printer ()
suppressOnside :: Printer () -> Printer ()
suppressOnside Printer ()
printer = do
    Bool
nl <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psNewline
    Int
onsideIndent <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int
psOnside
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
nl forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PrintState
s -> PrintState
s { psOnside :: Int
psOnside = Int
0 }
    Printer ()
printer
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PrintState
s -> PrintState
s { psOnside :: Int
psOnside = Int
onsideIndent }

depend :: Text -> Printer a -> Printer a
depend :: forall a. Text -> Printer a -> Printer a
depend Text
kw = forall a. Printer () -> Printer a -> Printer a
depend' (Text -> Printer ()
write Text
kw)

depend' :: Printer () -> Printer a -> Printer a
depend' :: forall a. Printer () -> Printer a -> Printer a
depend' Printer ()
kw Printer a
p = do
    Int
i <- forall b. (Config -> b) -> Printer b
getConfig (IndentConfig -> Int
cfgIndentOnside forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> IndentConfig
cfgIndent)
    Printer ()
kw
    Printer ()
space
    forall a. Int -> Printer a -> Printer a
indented Int
i Printer a
p

-- | Wrap in parens.
parens :: Printer () -> Printer ()
parens :: Printer () -> Printer ()
parens Printer ()
p = do
    Text -> Printer ()
write Text
"("
    forall a. Printer a -> Printer a
aligned forall a b. (a -> b) -> a -> b
$ do
        Printer ()
p
        Text -> Printer ()
write Text
")"

-- | Wrap in brackets.
brackets :: Printer () -> Printer ()
brackets :: Printer () -> Printer ()
brackets Printer ()
p = do
    Text -> Printer ()
write Text
"["
    forall a. Printer a -> Printer a
aligned forall a b. (a -> b) -> a -> b
$ do
        Printer ()
p
        Text -> Printer ()
write Text
"]"

group :: LayoutContext -> Text -> Text -> Printer () -> Printer ()
group :: LayoutContext -> Text -> Text -> Printer () -> Printer ()
group LayoutContext
ctx Text
open Text
close Printer ()
p = do
    Bool
force <- forall b. (Config -> b) -> Printer b
getConfig (Whitespace -> Bool
wsForceLinebreak forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutContext -> Text -> GroupConfig -> Whitespace
cfgGroupWs LayoutContext
ctx Text
open forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> GroupConfig
cfgGroup)
    if Bool
force then Printer ()
vert else forall a. Printer a -> Printer a
oneline Printer ()
hor forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Printer ()
vert
  where
    hor :: Printer ()
hor = LayoutContext -> Text -> Text -> Printer () -> Printer ()
groupH LayoutContext
ctx Text
open Text
close Printer ()
p

    vert :: Printer ()
vert = LayoutContext -> Text -> Text -> Printer () -> Printer ()
groupV LayoutContext
ctx Text
open Text
close Printer ()
p

groupH :: LayoutContext -> Text -> Text -> Printer () -> Printer ()
groupH :: LayoutContext -> Text -> Text -> Printer () -> Printer ()
groupH LayoutContext
ctx Text
open Text
close Printer ()
p = do
    Whitespace
ws <- forall b. (Config -> b) -> Printer b
getConfig (LayoutContext -> Text -> GroupConfig -> Whitespace
cfgGroupWs LayoutContext
ctx Text
open forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> GroupConfig
cfgGroup)
    Text -> Printer ()
write Text
open
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Location -> Whitespace -> Bool
wsSpace Location
Before Whitespace
ws) Printer ()
space
    Printer ()
p
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Location -> Whitespace -> Bool
wsSpace Location
After Whitespace
ws) Printer ()
space
    Text -> Printer ()
write Text
close

groupV :: LayoutContext -> Text -> Text -> Printer () -> Printer ()
groupV :: LayoutContext -> Text -> Text -> Printer () -> Printer ()
groupV LayoutContext
ctx Text
open Text
close Printer ()
p = forall a. Printer a -> Printer a
aligned forall a b. (a -> b) -> a -> b
$ do
    Whitespace
ws <- forall b. (Config -> b) -> Printer b
getConfig (LayoutContext -> Text -> GroupConfig -> Whitespace
cfgGroupWs LayoutContext
ctx Text
open forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> GroupConfig
cfgGroup)
    Text -> Printer ()
write Text
open
    if Location -> Whitespace -> Bool
wsLinebreak Location
Before Whitespace
ws then Printer ()
newline else forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Location -> Whitespace -> Bool
wsSpace Location
Before Whitespace
ws) Printer ()
space
    Printer ()
p
    if Location -> Whitespace -> Bool
wsLinebreak Location
After Whitespace
ws then Printer ()
newline else forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Location -> Whitespace -> Bool
wsSpace Location
After Whitespace
ws) Printer ()
space
    Text -> Printer ()
write Text
close

operator :: LayoutContext -> Text -> Printer ()
operator :: LayoutContext -> Text -> Printer ()
operator LayoutContext
ctx Text
op = forall a.
LayoutContext
-> Text -> Printer () -> (Printer () -> Printer a) -> Printer a
withOperatorFormatting LayoutContext
ctx Text
op (Text -> Printer ()
write Text
op) forall a. a -> a
id

operatorH :: LayoutContext -> Text -> Printer ()
operatorH :: LayoutContext -> Text -> Printer ()
operatorH LayoutContext
ctx Text
op = forall a.
LayoutContext
-> Text -> Printer () -> (Printer () -> Printer a) -> Printer a
withOperatorFormattingH LayoutContext
ctx Text
op (Text -> Printer ()
write Text
op) forall a. a -> a
id

operatorV :: LayoutContext -> Text -> Printer ()
operatorV :: LayoutContext -> Text -> Printer ()
operatorV LayoutContext
ctx Text
op = forall a.
LayoutContext
-> Text -> Printer () -> (Printer () -> Printer a) -> Printer a
withOperatorFormattingV LayoutContext
ctx Text
op (Text -> Printer ()
write Text
op) forall a. a -> a
id

alignOnOperator :: LayoutContext -> Text -> Printer a -> Printer a
alignOnOperator :: forall a. LayoutContext -> Text -> Printer a -> Printer a
alignOnOperator LayoutContext
ctx Text
op Printer a
p =
    forall a.
LayoutContext
-> Text -> Printer () -> (Printer () -> Printer a) -> Printer a
withOperatorFormatting LayoutContext
ctx Text
op (Text -> Printer ()
write Text
op) (forall a. Printer a -> Printer a
aligned forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Printer a
p))

withOperatorFormatting :: LayoutContext
                       -> Text
                       -> Printer ()
                       -> (Printer () -> Printer a)
                       -> Printer a
withOperatorFormatting :: forall a.
LayoutContext
-> Text -> Printer () -> (Printer () -> Printer a) -> Printer a
withOperatorFormatting LayoutContext
ctx Text
op Printer ()
opp Printer () -> Printer a
fn = do
    Bool
force <- forall b. (Config -> b) -> Printer b
getConfig (Whitespace -> Bool
wsForceLinebreak forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutContext -> Text -> OpConfig -> Whitespace
cfgOpWs LayoutContext
ctx Text
op forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> OpConfig
cfgOp)
    if Bool
force then Printer a
vert else Printer a
hor forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Printer a
vert
  where
    hor :: Printer a
hor = forall a.
LayoutContext
-> Text -> Printer () -> (Printer () -> Printer a) -> Printer a
withOperatorFormattingH LayoutContext
ctx Text
op Printer ()
opp Printer () -> Printer a
fn

    vert :: Printer a
vert = forall a.
LayoutContext
-> Text -> Printer () -> (Printer () -> Printer a) -> Printer a
withOperatorFormattingV LayoutContext
ctx Text
op Printer ()
opp Printer () -> Printer a
fn

withOperatorFormattingH :: LayoutContext
                        -> Text
                        -> Printer ()
                        -> (Printer () -> Printer a)
                        -> Printer a
withOperatorFormattingH :: forall a.
LayoutContext
-> Text -> Printer () -> (Printer () -> Printer a) -> Printer a
withOperatorFormattingH LayoutContext
ctx Text
op Printer ()
opp Printer () -> Printer a
fn = do
    Whitespace
ws <- forall b. (Config -> b) -> Printer b
getConfig (LayoutContext -> Text -> OpConfig -> Whitespace
cfgOpWs LayoutContext
ctx Text
op forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> OpConfig
cfgOp)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Location -> Whitespace -> Bool
wsSpace Location
Before Whitespace
ws) Printer ()
space
    Printer () -> Printer a
fn forall a b. (a -> b) -> a -> b
$ do
        Printer ()
opp
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Location -> Whitespace -> Bool
wsSpace Location
After Whitespace
ws) Printer ()
space

withOperatorFormattingV :: LayoutContext
                        -> Text
                        -> Printer ()
                        -> (Printer () -> Printer a)
                        -> Printer a
withOperatorFormattingV :: forall a.
LayoutContext
-> Text -> Printer () -> (Printer () -> Printer a) -> Printer a
withOperatorFormattingV LayoutContext
ctx Text
op Printer ()
opp Printer () -> Printer a
fn = do
    Whitespace
ws <- forall b. (Config -> b) -> Printer b
getConfig (LayoutContext -> Text -> OpConfig -> Whitespace
cfgOpWs LayoutContext
ctx Text
op forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> OpConfig
cfgOp)
    if Location -> Whitespace -> Bool
wsLinebreak Location
Before Whitespace
ws
        then Printer ()
ensureNewline
        else forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Location -> Whitespace -> Bool
wsSpace Location
Before Whitespace
ws) Printer ()
space
    Printer () -> Printer a
fn forall a b. (a -> b) -> a -> b
$ do
        Printer ()
opp
        if Location -> Whitespace -> Bool
wsLinebreak Location
After Whitespace
ws then Printer ()
newline else forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Location -> Whitespace -> Bool
wsSpace Location
After Whitespace
ws) Printer ()
space

operatorSectionL :: LayoutContext -> Text -> Printer () -> Printer ()
operatorSectionL :: LayoutContext -> Text -> Printer () -> Printer ()
operatorSectionL LayoutContext
ctx Text
op Printer ()
opp = do
    Whitespace
ws <- forall b. (Config -> b) -> Printer b
getConfig (LayoutContext -> Text -> OpConfig -> Whitespace
cfgOpWs LayoutContext
ctx Text
op forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> OpConfig
cfgOp)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Location -> Whitespace -> Bool
wsSpace Location
Before Whitespace
ws) Printer ()
space
    Printer ()
opp

operatorSectionR :: LayoutContext -> Text -> Printer () -> Printer ()
operatorSectionR :: LayoutContext -> Text -> Printer () -> Printer ()
operatorSectionR LayoutContext
ctx Text
op Printer ()
opp = do
    Whitespace
ws <- forall b. (Config -> b) -> Printer b
getConfig (LayoutContext -> Text -> OpConfig -> Whitespace
cfgOpWs LayoutContext
ctx Text
op forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> OpConfig
cfgOp)
    Printer ()
opp
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Location -> Whitespace -> Bool
wsSpace Location
After Whitespace
ws) Printer ()
space

comma :: Printer ()
comma :: Printer ()
comma = LayoutContext -> Text -> Printer ()
operator LayoutContext
Expression Text
","