{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Language.Sexp.Pretty ( prettySexp' , prettySexp , prettySexps ) where import Data.ByteString.Lazy.Char8 (ByteString) import Data.Scientific import qualified Data.Text.Lazy as Lazy import Data.Text.Lazy.Encoding (encodeUtf8) import Text.PrettyPrint.Leijen.Text import Language.Sexp.Types instance Pretty Kw where pretty (Kw s) = colon <> text (Lazy.fromStrict s) ppAtom :: Atom -> Doc ppAtom (AtomBool a) = if a then "#t" else "#f" ppAtom (AtomInt a) = integer a ppAtom (AtomReal a) = text . Lazy.pack . formatScientific Generic Nothing $ a ppAtom (AtomString a) = pretty (show a) ppAtom (AtomSymbol a) = text . Lazy.fromStrict $ a ppAtom (AtomKeyword k) = pretty k instance Pretty Atom where pretty = ppAtom ppSexp :: Sexp -> Doc ppSexp (Atom _ a) = ppAtom a ppSexp (Vector _ ss) = brackets (align $ sep (map ppSexp ss)) ppSexp (Quoted _ a) = squote <> ppSexp a ppSexp (List _ ss) = parens (align $ sep (map ppSexp ss)) instance Pretty Sexp where pretty = ppSexp -- | Pretty-print a Sexp to a Text prettySexp' :: Sexp -> Lazy.Text prettySexp' = displayT . renderPretty 0.5 75 . ppSexp {-# INLINE prettySexp' #-} -- | Pretty-print a Sexp to a ByteString prettySexp :: Sexp -> ByteString prettySexp = encodeUtf8 . prettySexp' -- | Pretty-print a list of Sexps as a sequence of S-expressions to a ByteString prettySexps :: [Sexp] -> ByteString prettySexps = encodeUtf8 . displayT . renderPretty 0.5 75 . vcat . punctuate (line <> line) . map ppSexp