{-# LANGUAGE OverloadedStrings #-}

module Floskell.Printers
    ( getConfig
    , getOption
    , cut
    , oneline
    , ignoreOneline
      -- * Basic printing
    , write
    , string
    , int
    , space
    , newline
    , blankline
    , spaceOrNewline
      -- * Tab stops
    , withTabStops
    , atTabStop
      -- * Combinators
    , mayM_
    , withPrefix
    , withPostfix
    , withIndentConfig
    , withIndent
    , withIndentFlex
    , withIndentAfter
    , withIndentBy
    , withLayout
    , inter
      -- * Indentation
    , getNextColumn
    , column
    , aligned
    , indented
    , onside
    , 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.ByteString            ( ByteString )
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Builder    as BB
import qualified Data.ByteString.Lazy       as BL
import           Data.List                  ( intersperse )
import qualified Data.Map.Strict            as Map
import           Data.Monoid                ( (<>) )

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 :: (Config -> b) -> Printer b
getConfig Config -> b
f = Config -> b
f (Config -> b) -> Printer Config -> Printer b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PrintState -> Config) -> Printer Config
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 :: (OptionConfig -> a) -> Printer a
getOption OptionConfig -> a
f = (Config -> a) -> Printer a
forall b. (Config -> b) -> Printer b
getConfig (OptionConfig -> a
f (OptionConfig -> a) -> (Config -> OptionConfig) -> Config -> a
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 <- (PrintState -> Int) -> Printer Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int
psIndentLevel
    PenaltyConfig
config <- (Config -> PenaltyConfig) -> Printer PenaltyConfig
forall b. (Config -> b) -> Printer b
getConfig Config -> PenaltyConfig
cfgPenalty
    let maxcol :: Int
maxcol = PenaltyConfig -> Int
penaltyMaxLineLength PenaltyConfig
config
    let pLinebreak :: Int
pLinebreak = Bool -> Int -> Int
forall p. Num p => Bool -> p -> p
onlyIf Bool
eol (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ PenaltyConfig -> Int
penaltyLinebreak PenaltyConfig
config
    let pIndent :: Int
pIndent = Int
indentLevel Int -> Int -> Int
forall a. Num a => a -> a -> a
* PenaltyConfig -> Int
penaltyIndent PenaltyConfig
config
    let pOverfull :: Int
pOverfull = Bool -> Int -> Int
forall p. Num p => Bool -> p -> p
onlyIf (Int
col Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxcol) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ PenaltyConfig -> Int
penaltyOverfull PenaltyConfig
config
            Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxcol) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PenaltyConfig -> Int
penaltyOverfullOnce PenaltyConfig
config
    Penalty -> Printer Penalty
forall (m :: * -> *) a. Monad m => a -> m a
return (Penalty -> Printer Penalty)
-> (Int -> Penalty) -> Int -> Printer Penalty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Penalty
Penalty (Int -> Printer Penalty) -> Int -> Printer Penalty
forall a b. (a -> b) -> a -> b
$ Int
pLinebreak Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pIndent Int -> Int -> Int
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 :: Printer a -> Printer a
cut = Printer a -> Printer a
forall c (m :: * -> *) a. MonadSearch c m => m a -> m a
winner

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

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

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

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

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

-- | Write a string.
string :: String -> Printer ()
string :: String -> Printer ()
string = ByteString -> Printer ()
write (ByteString -> Printer ())
-> (String -> ByteString) -> String -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (String -> Builder) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
BB.stringUtf8

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

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

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

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

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

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

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

mayM_ :: Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ :: Maybe a -> (a -> Printer ()) -> Printer ()
mayM_ Maybe a
Nothing a -> Printer ()
_ = () -> 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 :: f a -> (x -> f b) -> x -> f b
withPrefix f a
pre x -> f b
f x
x = f a
pre f a -> f b -> f b
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 :: f a -> (x -> f b) -> x -> f b
withPostfix f a
post x -> f b
f x
x = x -> f b
f x
x f b -> f a -> f b
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 :: (IndentConfig -> Indent)
-> Printer a -> (Int -> Printer a) -> Printer a
withIndentConfig IndentConfig -> Indent
fn Printer a
align Int -> Printer a
indentby = do
    Indent
cfg <- (Config -> Indent) -> Printer Indent
forall b. (Config -> b) -> Printer b
getConfig (IndentConfig -> Indent
fn (IndentConfig -> Indent)
-> (Config -> IndentConfig) -> Config -> Indent
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 Printer a -> Printer a -> Printer a
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 :: (IndentConfig -> Indent) -> Printer a -> Printer a
withIndent IndentConfig -> Indent
fn Printer a
p = (IndentConfig -> Indent)
-> Printer a -> (Int -> Printer a) -> Printer a
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
        Printer a -> Printer a
forall a. Printer a -> Printer a
aligned Printer a
p

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

withIndentFlex :: (IndentConfig -> Indent) -> Printer a -> Printer a
withIndentFlex :: (IndentConfig -> Indent) -> Printer a -> Printer a
withIndentFlex IndentConfig -> Indent
fn Printer a
p = (IndentConfig -> Indent)
-> Printer a -> (Int -> Printer a) -> Printer a
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
        Printer a -> Printer a
forall a. Printer a -> Printer a
aligned Printer a
p

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

withIndentAfter
    :: (IndentConfig -> Indent) -> Printer () -> Printer a -> Printer a
withIndentAfter :: (IndentConfig -> Indent) -> Printer () -> Printer a -> Printer a
withIndentAfter IndentConfig -> Indent
fn Printer ()
before Printer a
p = (IndentConfig -> Indent)
-> Printer a -> (Int -> Printer a) -> Printer a
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 = Printer a -> Printer a
forall a. Printer a -> Printer a
aligned (Printer a -> Printer a) -> Printer a -> Printer a
forall a b. (a -> b) -> a -> b
$ do
        ((Int, Int) -> (Int, Int)) -> Printer () -> Printer ()
forall a. ((Int, Int) -> (Int, Int)) -> Printer a -> Printer a
withIndentation (Int, Int) -> (Int, Int)
forall a. a -> a
id Printer ()
before
        Printer a
p

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

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

withLayout :: (LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout :: (LayoutConfig -> Layout) -> Printer a -> Printer a -> Printer a
withLayout LayoutConfig -> Layout
fn Printer a
flex Printer a
vertical = do
    Layout
cfg <- (Config -> Layout) -> Printer Layout
forall b. (Config -> b) -> Printer b
getConfig (LayoutConfig -> Layout
fn (LayoutConfig -> Layout)
-> (Config -> LayoutConfig) -> Config -> Layout
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 -> Printer a -> Printer a
forall a. Printer a -> Printer a
oneline Printer a
flex Printer a -> Printer a -> Printer a
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 = [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 ()
x

-- | Get the column for the next printed character.
getNextColumn :: Printer Int
getNextColumn :: Printer Int
getNextColumn = do
    PrintState
st <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
    Int -> Printer Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Printer Int) -> Int -> Printer Int
forall a b. (a -> b) -> a -> b
$ if PrintState -> Bool
psEolComment PrintState
st
             then PrintState -> Int
psIndentLevel PrintState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PrintState -> Int
psOnside PrintState
st
             else Int -> Int -> Int
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 :: ((Int, Int) -> (Int, Int)) -> Printer a -> Printer a
withIndentation (Int, Int) -> (Int, Int)
f Printer a
p = do
    Int
prevIndent <- (PrintState -> Int) -> Printer Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int
psIndentLevel
    Int
prevOnside <- (PrintState -> Int) -> Printer Int
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)
    (PrintState -> PrintState) -> Printer ()
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
    (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PrintState
s -> PrintState
s { psIndentLevel :: Int
psIndentLevel = Int
prevIndent, psOnside :: Int
psOnside = Int
prevOnside })
    a -> Printer a
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 :: Int -> Printer a -> Printer a
column Int
i = ((Int, Int) -> (Int, Int)) -> Printer a -> Printer a
forall a. ((Int, Int) -> (Int, Int)) -> Printer a -> Printer a
withIndentation (((Int, Int) -> (Int, Int)) -> Printer a -> Printer a)
-> ((Int, Int) -> (Int, Int)) -> Printer a -> Printer a
forall a b. (a -> b) -> a -> b
$ \(Int
l, Int
o) -> (Int
i, if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l then Int
0 else Int
o)

aligned :: Printer a -> Printer a
aligned :: Printer a -> Printer a
aligned Printer a
p = do
    Int
col <- Printer Int
getNextColumn
    Int -> Printer a -> Printer a
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 :: Int -> Printer a -> Printer a
indented Int
i Printer a
p = do
    Int
level <- (PrintState -> Int) -> Printer Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Int
psIndentLevel
    Int -> Printer a -> Printer a
forall a. Int -> Printer a -> Printer a
column (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) Printer a
p

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

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

depend' :: Printer () -> Printer a -> Printer a
depend' :: Printer () -> Printer a -> Printer a
depend' Printer ()
kw Printer a
p = do
    Int
i <- (Config -> Int) -> Printer Int
forall b. (Config -> b) -> Printer b
getConfig (IndentConfig -> Int
cfgIndentOnside (IndentConfig -> Int) -> (Config -> IndentConfig) -> Config -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> IndentConfig
cfgIndent)
    Printer ()
kw
    Printer ()
space
    Int -> Printer a -> Printer a
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
    ByteString -> Printer ()
write ByteString
"("
    Printer () -> Printer ()
forall a. Printer a -> Printer a
aligned (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
        Printer ()
p
        ByteString -> Printer ()
write ByteString
")"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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