{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Data.Text.Prettyprint.Doc.Extra
  ( module Data.Text.Prettyprint.Doc.Extra
  , LayoutOptions (..)
  , PageWidth (..)
  , layoutCompact
  , layoutPretty
  , renderLazy
  )
where

import           Control.Applicative
import           Data.String                           (IsString (..))
import           Data.Text                             as T
import           Data.Text.Lazy                        as LT

#if MIN_VERSION_prettyprinter(1,7,0)
import qualified Prettyprinter                         as PP
import           Prettyprinter.Internal                hiding (Doc)
import           Prettyprinter.Render.Text
#else
import qualified Data.Text.Prettyprint.Doc             as PP
import           Data.Text.Prettyprint.Doc.Internal    hiding (Doc)
import           Data.Text.Prettyprint.Doc.Render.Text
#endif

type Doc = PP.Doc ()

layoutOneLine
  :: PP.Doc ann
  -> SimpleDocStream ann
layoutOneLine :: Doc ann -> SimpleDocStream ann
layoutOneLine Doc ann
doc = Int -> [Doc ann] -> SimpleDocStream ann
forall ann ann. Int -> [Doc ann] -> SimpleDocStream ann
scan Int
0 [Doc ann
doc]
  where
    scan :: Int -> [Doc ann] -> SimpleDocStream ann
scan Int
_ [] = SimpleDocStream ann
forall ann. SimpleDocStream ann
SEmpty
    scan !Int
col (Doc ann
d:[Doc ann]
ds) = case Doc ann
d of
        Doc ann
Fail            -> SimpleDocStream ann
forall ann. SimpleDocStream ann
SFail
        Doc ann
Empty           -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col [Doc ann]
ds
        Char Char
c          -> Char -> SimpleDocStream ann -> SimpleDocStream ann
forall ann. Char -> SimpleDocStream ann -> SimpleDocStream ann
SChar Char
c (Int -> [Doc ann] -> SimpleDocStream ann
scan (Int
colInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Doc ann]
ds)
        Text Int
l Text
t        -> let !col' :: Int
col' = Int
colInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l in Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
forall ann.
Int -> Text -> SimpleDocStream ann -> SimpleDocStream ann
SText Int
l Text
t (Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col' [Doc ann]
ds)
        FlatAlt Doc ann
x Doc ann
_     -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col (Doc ann
xDoc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
:[Doc ann]
ds)
        Doc ann
Line            -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col [Doc ann]
ds
        Cat Doc ann
x Doc ann
y         -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col (Doc ann
xDoc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
:Doc ann
yDoc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
:[Doc ann]
ds)
        Nest Int
_ Doc ann
x        -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col (Doc ann
xDoc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
:[Doc ann]
ds)
        Union Doc ann
_ Doc ann
y       -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col (Doc ann
yDoc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
:[Doc ann]
ds)
        Column Int -> Doc ann
f        -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col (Int -> Doc ann
f Int
colDoc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
:[Doc ann]
ds)
        WithPageWidth PageWidth -> Doc ann
f -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col (PageWidth -> Doc ann
f PageWidth
Unbounded Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
ds)
        Nesting Int -> Doc ann
f       -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col (Int -> Doc ann
f Int
0 Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
ds)
        Annotated ann
_ Doc ann
x   -> Int -> [Doc ann] -> SimpleDocStream ann
scan Int
col (Doc ann
xDoc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
:[Doc ann]
ds)

renderOneLine
  :: PP.Doc ann
  -> LT.Text
renderOneLine :: Doc ann -> Text
renderOneLine = SimpleDocStream ann -> Text
forall ann. SimpleDocStream ann -> Text
renderLazy (SimpleDocStream ann -> Text)
-> (Doc ann -> SimpleDocStream ann) -> Doc ann -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions

int :: Applicative f => Int -> f Doc
int :: Int -> f Doc
int = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Doc -> f Doc) -> (Int -> Doc) -> Int -> f Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc
forall a ann. Pretty a => a -> Doc ann
PP.pretty

integer :: Applicative f => Integer -> f Doc
integer :: Integer -> f Doc
integer = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Doc -> f Doc) -> (Integer -> Doc) -> Integer -> f Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Doc
forall a ann. Pretty a => a -> Doc ann
PP.pretty

char :: Applicative f => Char -> f Doc
char :: Char -> f Doc
char = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Doc -> f Doc) -> (Char -> Doc) -> Char -> f Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Doc
forall a ann. Pretty a => a -> Doc ann
PP.pretty

lbrace :: Applicative f => f Doc
lbrace :: f Doc
lbrace = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
PP.lbrace

rbrace :: Applicative f => f Doc
rbrace :: f Doc
rbrace = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
PP.rbrace

colon :: Applicative f => f Doc
colon :: f Doc
colon = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
PP.colon

semi :: Applicative f => f Doc
semi :: f Doc
semi = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
PP.semi

equals :: Applicative f => f Doc
equals :: f Doc
equals = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
PP.equals

comma :: Applicative f => f Doc
comma :: f Doc
comma = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
PP.comma

dot :: Applicative f => f Doc
dot :: f Doc
dot = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
PP.dot

lparen :: Applicative f => f Doc
lparen :: f Doc
lparen = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
PP.lparen

rparen :: Applicative f => f Doc
rparen :: f Doc
rparen = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
PP.rparen

space :: Applicative f => f Doc
space :: f Doc
space = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
PP.space

brackets :: Functor f => f Doc -> f Doc
brackets :: f Doc -> f Doc
brackets = (Doc -> Doc) -> f Doc -> f Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
forall ann. Doc ann -> Doc ann
PP.brackets

braces :: Functor f => f Doc -> f Doc
braces :: f Doc -> f Doc
braces = (Doc -> Doc) -> f Doc -> f Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
forall ann. Doc ann -> Doc ann
PP.braces

tupled :: Functor f => f [Doc] -> f Doc
tupled :: f [Doc] -> f Doc
tupled = ([Doc] -> Doc) -> f [Doc] -> f Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
PP.tupled

(<+>) :: Applicative f => f Doc -> f Doc -> f Doc
<+> :: f Doc -> f Doc -> f Doc
(<+>) = (Doc -> Doc -> Doc) -> f Doc -> f Doc -> f Doc
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann
(PP.<+>)
infixr 6 <+>

vcat :: Functor f => f [Doc] -> f Doc
vcat :: f [Doc] -> f Doc
vcat = ([Doc] -> Doc) -> f [Doc] -> f Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
PP.vcat

hcat :: Functor f => f [Doc] -> f Doc
hcat :: f [Doc] -> f Doc
hcat = ([Doc] -> Doc) -> f [Doc] -> f Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
PP.hcat

nest :: Functor f => Int -> f Doc -> f Doc
nest :: Int -> f Doc -> f Doc
nest Int
i = (Doc -> Doc) -> f Doc -> f Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
PP.nest Int
i)

indent :: Functor f => Int -> f Doc -> f Doc
indent :: Int -> f Doc -> f Doc
indent Int
i = (Doc -> Doc) -> f Doc -> f Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
PP.indent Int
i)

parens :: Functor f => f Doc -> f Doc
parens :: f Doc -> f Doc
parens = (Doc -> Doc) -> f Doc -> f Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
forall ann. Doc ann -> Doc ann
PP.parens

emptyDoc :: Applicative f => f Doc
emptyDoc :: f Doc
emptyDoc = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
PP.emptyDoc

punctuate :: Applicative f => f Doc -> f [Doc] -> f [Doc]
punctuate :: f Doc -> f [Doc] -> f [Doc]
punctuate = (Doc -> [Doc] -> [Doc]) -> f Doc -> f [Doc] -> f [Doc]
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Doc -> [Doc] -> [Doc]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
PP.punctuate

encloseSep :: Applicative f => f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc
encloseSep :: f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc
encloseSep f Doc
l f Doc
r f Doc
s f [Doc]
is = Doc -> Doc -> Doc -> [Doc] -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
PP.encloseSep (Doc -> Doc -> Doc -> [Doc] -> Doc)
-> f Doc -> f (Doc -> Doc -> [Doc] -> Doc)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f Doc
l f (Doc -> Doc -> [Doc] -> Doc) -> f Doc -> f (Doc -> [Doc] -> Doc)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f Doc
r f (Doc -> [Doc] -> Doc) -> f Doc -> f ([Doc] -> Doc)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f Doc
s f ([Doc] -> Doc) -> f [Doc] -> f Doc
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f [Doc]
is

enclose :: Applicative f => f Doc -> f Doc -> f Doc -> f Doc
enclose :: f Doc -> f Doc -> f Doc -> f Doc
enclose = (Doc -> Doc -> Doc -> Doc) -> f Doc -> f Doc -> f Doc -> f Doc
forall (f :: Type -> Type) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Doc -> Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
PP.enclose

line :: Applicative f => f Doc
line :: f Doc
line = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
PP.line

line' :: Applicative f => f Doc
line' :: f Doc
line' = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
PP.line'

softline :: Applicative f => f Doc
softline :: f Doc
softline = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
PP.softline

softline' :: Applicative f => f Doc
softline' :: f Doc
softline' = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
PP.softline'

pretty :: (Applicative f, Pretty a) => a -> f Doc
pretty :: a -> f Doc
pretty = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Doc -> f Doc) -> (a -> Doc) -> a -> f Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a ann. Pretty a => a -> Doc ann
PP.pretty

stringS :: Applicative f => T.Text -> f Doc
stringS :: Text -> f Doc
stringS = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Doc -> f Doc) -> (Text -> Doc) -> Text -> f Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc
forall a ann. Pretty a => a -> Doc ann
PP.pretty

string :: Applicative f => LT.Text -> f Doc
string :: Text -> f Doc
string = Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Doc -> f Doc) -> (Text -> Doc) -> Text -> f Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc
forall a ann. Pretty a => a -> Doc ann
PP.pretty

squotes :: Applicative f => f Doc -> f Doc
squotes :: f Doc -> f Doc
squotes = (Doc -> Doc) -> f Doc -> f Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
forall ann. Doc ann -> Doc ann
PP.squotes

dquotes :: Functor f => f Doc -> f Doc
dquotes :: f Doc -> f Doc
dquotes = (Doc -> Doc) -> f Doc -> f Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
forall ann. Doc ann -> Doc ann
PP.dquotes

align :: Functor f => f Doc -> f Doc
align :: f Doc -> f Doc
align = (Doc -> Doc) -> f Doc -> f Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
forall ann. Doc ann -> Doc ann
PP.align

hsep :: Functor f => f [Doc] -> f Doc
hsep :: f [Doc] -> f Doc
hsep = ([Doc] -> Doc) -> f [Doc] -> f Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
PP.hsep

vsep :: Functor f => f [Doc] -> f Doc
vsep :: f [Doc] -> f Doc
vsep = ([Doc] -> Doc) -> f [Doc] -> f Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
PP.vsep

isEmpty :: Doc -> Bool
isEmpty :: Doc -> Bool
isEmpty Doc
Empty = Bool
True
isEmpty Doc
_     = Bool
False

fill :: Applicative f => Int -> f Doc -> f Doc
fill :: Int -> f Doc -> f Doc
fill = (Doc -> Doc) -> f Doc -> f Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Doc -> Doc) -> f Doc -> f Doc)
-> (Int -> Doc -> Doc) -> Int -> f Doc -> f Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
PP.fill

column :: Functor f => f (Int -> Doc) -> f Doc
column :: f (Int -> Doc) -> f Doc
column = ((Int -> Doc) -> Doc) -> f (Int -> Doc) -> f Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Doc) -> Doc
forall ann. (Int -> Doc ann) -> Doc ann
PP.column

nesting :: Functor f => f (Int -> Doc) -> f Doc
nesting :: f (Int -> Doc) -> f Doc
nesting = ((Int -> Doc) -> Doc) -> f (Int -> Doc) -> f Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Doc) -> Doc
forall ann. (Int -> Doc ann) -> Doc ann
PP.nesting

flatAlt :: Applicative f => f Doc -> f Doc -> f Doc
flatAlt :: f Doc -> f Doc -> f Doc
flatAlt = (Doc -> Doc -> Doc) -> f Doc -> f Doc -> f Doc
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann
PP.flatAlt

instance Applicative f => IsString (f Doc) where
  fromString :: String -> f Doc
fromString = Text -> f Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (Text -> f Doc) -> (String -> Text) -> String -> f Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

comment :: Applicative f => T.Text -> T.Text -> f Doc
comment :: Text -> Text -> f Doc
comment Text
prefix Text
comm =
  let go :: a -> Doc ann
go a
s = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty Text
prefix Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
PP.<+> a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty a
s in
  Doc -> f Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
PP.vsep ((Text -> Doc) -> [Text] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Text -> Doc
forall a ann. Pretty a => a -> Doc ann
go (Text -> [Text]
T.lines Text
comm)))

squote :: Applicative f => f Doc
squote :: f Doc
squote = Text -> f Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (String -> Text
LT.pack String
"'")