{-# LANGUAGE CPP #-}

-- | 'LaTeX' values pretty printer.
--
--   Still experimental. Give it a try and send us your feedback! :)
module Text.LaTeX.Base.Pretty (
    -- * @LaTeX@ pretty printer
    prettyLaTeX
    -- * Configurable printer
  , docLaTeX
  ) where

import Text.LaTeX.Base.Syntax
import Text.LaTeX.Base.Render
import Prettyprinter
  ( Doc, pretty
  , backslash, line, softline, hardline
  , braces, brackets
  , indent, align, vsep
  , list, encloseSep
  , LayoutOptions (..)
  , PageWidth (..)
  , layoutSmart
    )
import Prettyprinter.Render.String (renderString)
import Data.Text (unpack,lines)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (mconcat,mempty)
#endif

text :: Text -> Doc ann
text :: forall ann. Text -> Doc ann
text = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty

-- | This function transforms a value of type 'LaTeX' to a 'Doc'.
--   You can then choose how to print this 'Doc' value using
--   the function from the "Text.PrettyPrint.Free" module.
docLaTeX :: LaTeX -> Doc ()
docLaTeX :: LaTeX -> Doc ()
docLaTeX (TeXRaw Text
t) = String -> Doc ()
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ()) -> String -> Doc ()
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
t
docLaTeX (TeXComm String
n [TeXArg]
as) = Doc ()
forall ann. Doc ann
backslash Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> String -> Doc ()
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
n Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
align ([Doc ()] -> Doc ()
forall a. Monoid a => [a] -> a
mconcat ((TeXArg -> Doc ()) -> [TeXArg] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TeXArg -> Doc ()
docTeXArg [TeXArg]
as)) Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
softline
docLaTeX (TeXCommS String
n) = Doc ()
forall ann. Doc ann
backslash Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> String -> Doc ()
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
n Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
softline
docLaTeX (TeXEnv String
n [TeXArg]
as LaTeX
b) =
  let a :: TeXArg
a = LaTeX -> TeXArg
FixArg (LaTeX -> TeXArg) -> LaTeX -> TeXArg
forall a b. (a -> b) -> a -> b
$ String -> LaTeX
forall a. IsString a => String -> a
fromString String
n
  in  [Doc ()] -> Doc ()
forall a. Monoid a => [a] -> a
mconcat
       [ Doc ()
forall ann. Doc ann
line
       , LaTeX -> Doc ()
docLaTeX (LaTeX -> Doc ()) -> LaTeX -> Doc ()
forall a b. (a -> b) -> a -> b
$ String -> [TeXArg] -> LaTeX
TeXComm String
"begin" ([TeXArg] -> LaTeX) -> [TeXArg] -> LaTeX
forall a b. (a -> b) -> a -> b
$ TeXArg
a TeXArg -> [TeXArg] -> [TeXArg]
forall a. a -> [a] -> [a]
: [TeXArg]
as
       , Int -> Doc () -> Doc ()
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 (Doc () -> Doc ()) -> Doc () -> Doc ()
forall a b. (a -> b) -> a -> b
$ LaTeX -> Doc ()
docLaTeX LaTeX
b
       , Doc ()
forall ann. Doc ann
line
       , LaTeX -> Doc ()
docLaTeX (LaTeX -> Doc ()) -> LaTeX -> Doc ()
forall a b. (a -> b) -> a -> b
$ String -> [TeXArg] -> LaTeX
TeXComm String
"end" [TeXArg
a]
         ]
docLaTeX (TeXMath MathType
t LaTeX
b) =
  let (Text
l,Text
r) =
        case MathType
t of
          MathType
Parentheses -> (Text
"\\(",Text
"\\)")
          MathType
Square -> (Text
"\\[",Text
"\\]")
          MathType
Dollar -> (Text
"$",Text
"$")
          MathType
DoubleDollar -> (Text
"$$",Text
"$$")
  in  Text -> Doc ()
forall ann. Text -> Doc ann
text Text
l Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> LaTeX -> Doc ()
docLaTeX LaTeX
b Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ()
forall ann. Text -> Doc ann
text Text
r
docLaTeX (TeXLineBreak Maybe Measure
m Bool
b) =
  Text -> Doc ()
forall ann. Text -> Doc ann
text Text
"\\\\" Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc () -> (Measure -> Doc ()) -> Maybe Measure -> Doc ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ()
forall a. Monoid a => a
mempty (Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
brackets (Doc () -> Doc ()) -> (Measure -> Doc ()) -> Measure -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc ()
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ()) -> (Measure -> String) -> Measure -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> String) -> (Measure -> Text) -> Measure -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measure -> Text
forall a. Render a => a -> Text
render) Maybe Measure
m Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> ( if Bool
b then Text -> Doc ()
forall ann. Text -> Doc ann
text Text
"*" else Doc ()
forall a. Monoid a => a
mempty )
docLaTeX (TeXBraces LaTeX
b) = Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
braces (Doc () -> Doc ()) -> Doc () -> Doc ()
forall a b. (a -> b) -> a -> b
$ LaTeX -> Doc ()
docLaTeX LaTeX
b
docLaTeX (TeXComment Text
t) =
  let ls :: [Text]
ls = Text -> [Text]
Data.Text.lines Text
t
  in  if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ls
         then Char -> Doc ()
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'%' Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
hardline
         else Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
align ([Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall a b. (a -> b) -> a -> b
$ (Text -> Doc ()) -> [Text] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Doc ()
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ()) -> (Text -> String) -> Text -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"% "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack) [Text]
ls) Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
hardline
docLaTeX (TeXSeq LaTeX
l1 LaTeX
l2) = LaTeX -> Doc ()
docLaTeX LaTeX
l1 Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> LaTeX -> Doc ()
docLaTeX LaTeX
l2
docLaTeX LaTeX
TeXEmpty = Doc ()
forall a. Monoid a => a
mempty

docTeXArg :: TeXArg -> Doc ()
docTeXArg :: TeXArg -> Doc ()
docTeXArg (FixArg LaTeX
l) = Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
braces (Doc () -> Doc ()) -> Doc () -> Doc ()
forall a b. (a -> b) -> a -> b
$ LaTeX -> Doc ()
docLaTeX LaTeX
l
docTeXArg (OptArg LaTeX
l) = Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
brackets (Doc () -> Doc ()) -> Doc () -> Doc ()
forall a b. (a -> b) -> a -> b
$ LaTeX -> Doc ()
docLaTeX LaTeX
l
docTeXArg (MOptArg [LaTeX]
ls) =
  if [LaTeX] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LaTeX]
ls then Doc ()
forall a. Monoid a => a
mempty
             else [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
list ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall a b. (a -> b) -> a -> b
$ (LaTeX -> Doc ()) -> [LaTeX] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LaTeX -> Doc ()
docLaTeX [LaTeX]
ls
docTeXArg (SymArg LaTeX
l) = TeXArg -> Doc ()
docTeXArg (TeXArg -> Doc ()) -> TeXArg -> Doc ()
forall a b. (a -> b) -> a -> b
$ [LaTeX] -> TeXArg
MSymArg [LaTeX
l]
docTeXArg (MSymArg [LaTeX]
ls) = Doc () -> Doc () -> Doc () -> [Doc ()] -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep (Char -> Doc ()
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'<') (Char -> Doc ()
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'>') (Char -> Doc ()
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
',') ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall a b. (a -> b) -> a -> b
$ (LaTeX -> Doc ()) -> [LaTeX] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LaTeX -> Doc ()
docLaTeX [LaTeX]
ls
docTeXArg (ParArg LaTeX
l) = TeXArg -> Doc ()
docTeXArg (TeXArg -> Doc ()) -> TeXArg -> Doc ()
forall a b. (a -> b) -> a -> b
$ [LaTeX] -> TeXArg
MParArg [LaTeX
l]
docTeXArg (MParArg [LaTeX]
ls) = Doc () -> Doc () -> Doc () -> [Doc ()] -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep (Char -> Doc ()
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'(') (Char -> Doc ()
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
')') (Char -> Doc ()
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
',') ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall a b. (a -> b) -> a -> b
$ (LaTeX -> Doc ()) -> [LaTeX] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LaTeX -> Doc ()
docLaTeX [LaTeX]
ls

-- | Pretty print a 'LaTeX' value. It produces a more human-friendly output than 'render'.
--
--   This function should be used only for debugging purposes since it may change
--   the semantics of the input in order to create a prettier output.
--   In other words, running a LaTeX compiler in the output file of @renderFile fp l@ may
--   produce a different document than running it in the output of @writeFile fp (prettyLaTeX l)@.
--   You should use 'renderFile' unless you really need to read the LaTeX file.
--
prettyLaTeX :: LaTeX -> String
prettyLaTeX :: LaTeX -> String
prettyLaTeX = SimpleDocStream () -> String
forall ann. SimpleDocStream ann -> String
renderString (SimpleDocStream () -> String)
-> (LaTeX -> SimpleDocStream ()) -> LaTeX -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc () -> SimpleDocStream ()
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart LayoutOptions
layout (Doc () -> SimpleDocStream ())
-> (LaTeX -> Doc ()) -> LaTeX -> SimpleDocStream ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LaTeX -> Doc ()
docLaTeX

layout :: LayoutOptions
layout :: LayoutOptions
layout = PageWidth -> LayoutOptions
LayoutOptions (PageWidth -> LayoutOptions) -> PageWidth -> LayoutOptions
forall a b. (a -> b) -> a -> b
$ Int -> Double -> PageWidth
AvailablePerLine Int
60 Double
1