Extra.hs

{-# 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
import qualified Data.Text.Prettyprint.Doc             as PP
import           Data.Text.Prettyprint.Doc.Internal    hiding (Doc)
import           Data.Text.Prettyprint.Doc.Render.Text

type Doc = PP.Doc ()

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

renderOneLine
  :: PP.Doc ann
  -> LT.Text
renderOneLine = renderLazy . layoutPretty defaultLayoutOptions

int :: Applicative f => Int -> f Doc
int = pure . PP.pretty

integer :: Applicative f => Integer -> f Doc
integer = pure . PP.pretty

char :: Applicative f => Char -> f Doc
char = pure . PP.pretty

lbrace :: Applicative f => f Doc
lbrace = pure PP.lbrace

rbrace :: Applicative f => f Doc
rbrace = pure PP.rbrace

colon :: Applicative f => f Doc
colon = pure PP.colon

semi :: Applicative f => f Doc
semi = pure PP.semi

equals :: Applicative f => f Doc
equals = pure PP.equals

comma :: Applicative f => f Doc
comma = pure PP.comma

dot :: Applicative f => f Doc
dot = pure PP.dot

lparen :: Applicative f => f Doc
lparen = pure PP.lparen

rparen :: Applicative f => f Doc
rparen = pure PP.rparen

space :: Applicative f => f Doc
space = pure PP.space

brackets :: Functor f => f Doc -> f Doc
brackets = fmap PP.brackets

braces :: Functor f => f Doc -> f Doc
braces = fmap PP.braces

tupled :: Functor f => f [Doc] -> f Doc
tupled = fmap PP.tupled

(<+>) :: Applicative f => f Doc -> f Doc -> f Doc
(<+>) = liftA2 (PP.<+>)
infixr 6 <+>

vcat :: Functor f => f [Doc] -> f Doc
vcat = fmap PP.vcat

hcat :: Functor f => f [Doc] -> f Doc
hcat = fmap PP.hcat

nest :: Functor f => Int -> f Doc -> f Doc
nest i = fmap (PP.nest i)

indent :: Functor f => Int -> f Doc -> f Doc
indent i = fmap (PP.indent i)

parens :: Functor f => f Doc -> f Doc
parens = fmap PP.parens

emptyDoc :: Applicative f => f Doc
emptyDoc = pure PP.emptyDoc

punctuate :: Applicative f => f Doc -> f [Doc] -> f [Doc]
punctuate = liftA2 PP.punctuate

encloseSep :: Applicative f => f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc
encloseSep l r s is = PP.encloseSep <$> l <*> r <*> s <*> is

enclose :: Applicative f => f Doc -> f Doc -> f Doc -> f Doc
enclose = liftA3 PP.enclose

line :: Applicative f => f Doc
line = pure PP.line

line' :: Applicative f => f Doc
line' = pure PP.line'

softline :: Applicative f => f Doc
softline = pure PP.softline

softline' :: Applicative f => f Doc
softline' = pure PP.softline'

pretty :: (Applicative f, Pretty a) => a -> f Doc
pretty = pure . PP.pretty

stringS :: Applicative f => T.Text -> f Doc
stringS = pure . PP.pretty

string :: Applicative f => LT.Text -> f Doc
string = pure . PP.pretty

squotes :: Applicative f => f Doc -> f Doc
squotes = fmap PP.squotes

dquotes :: Functor f => f Doc -> f Doc
dquotes = fmap PP.dquotes

align :: Functor f => f Doc -> f Doc
align = fmap PP.align

hsep :: Functor f => f [Doc] -> f Doc
hsep = fmap PP.hsep

vsep :: Functor f => f [Doc] -> f Doc
vsep = fmap PP.vsep

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

fill :: Applicative f => Int -> f Doc -> f Doc
fill = fmap . PP.fill

column :: Functor f => f (Int -> Doc) -> f Doc
column = fmap PP.column

nesting :: Functor f => f (Int -> Doc) -> f Doc
nesting = fmap PP.nesting

flatAlt :: Applicative f => f Doc -> f Doc -> f Doc
flatAlt = liftA2 PP.flatAlt

instance Applicative f => IsString (f Doc) where
  fromString = string . fromString

comment :: Applicative f => T.Text -> T.Text -> f Doc
comment prefix comm =
  let go s = PP.pretty prefix PP.<+> PP.pretty s in
  pure (PP.vsep (Prelude.map go (T.lines comm)))

squote :: Applicative f => f Doc
squote = string (LT.pack "'")