{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Language.Sexp.Pretty
( format
) where
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Functor.Foldable (para)
import Data.Scientific
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Encoding (encodeUtf8)
#if MIN_VERSION_prettyprinter(1,7,0)
import Prettyprinter
import Prettyprinter.Internal (unsafeTextWithoutNewlines)
import qualified Prettyprinter.Render.Text as Render
#else
import Data.Text.Prettyprint.Doc
import Data.Text.Prettyprint.Doc.Internal (unsafeTextWithoutNewlines)
import qualified Data.Text.Prettyprint.Doc.Render.Text as Render
#endif
import Language.Sexp.Types
import Language.Sexp.Token (escape)
instance Pretty Atom where
pretty :: forall ann. Atom -> Doc ann
pretty = \case
AtomNumber Scientific
a
| Scientific -> Bool
isInteger Scientific
a -> forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Fixed (forall a. a -> Maybe a
Just Int
0) Scientific
a
| Bool
otherwise -> forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Fixed forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ Scientific
a
AtomString Text
a -> forall ann. Doc ann -> Doc ann
dquotes (forall ann. Text -> Doc ann
unsafeTextWithoutNewlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict forall a b. (a -> b) -> a -> b
$ Text
a)
AtomSymbol Text
a -> forall a ann. Pretty a => a -> Doc ann
pretty Text
a
ppList :: [(Fix SexpF, Doc ann)] -> Doc ann
ppList :: forall ann. [(Fix SexpF, Doc ann)] -> Doc ann
ppList [(Fix SexpF, Doc ann)]
ls = case [(Fix SexpF, Doc ann)]
ls of
((Fix (AtomF Atom
_),Doc ann
_) : [(Fix SexpF, Doc ann)]
_) ->
forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall ann. Int -> Doc ann -> Doc ann
nest Int
1 forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Fix SexpF, Doc ann)]
ls
[(Fix SexpF, Doc ann)]
_other ->
forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Fix SexpF, Doc ann)]
ls
ppSexp :: Fix SexpF -> Doc ann
ppSexp :: forall ann. Fix SexpF -> Doc ann
ppSexp = forall t a. Recursive t => (Base t (t, a) -> a) -> t -> a
para forall a b. (a -> b) -> a -> b
$ \case
AtomF Atom
a -> forall a ann. Pretty a => a -> Doc ann
pretty Atom
a
ParenListF [(Fix SexpF, Doc ann)]
ss -> forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall ann. [(Fix SexpF, Doc ann)] -> Doc ann
ppList [(Fix SexpF, Doc ann)]
ss
BracketListF [(Fix SexpF, Doc ann)]
ss -> forall ann. Doc ann -> Doc ann
brackets forall a b. (a -> b) -> a -> b
$ forall ann. [(Fix SexpF, Doc ann)] -> Doc ann
ppList [(Fix SexpF, Doc ann)]
ss
BraceListF [(Fix SexpF, Doc ann)]
ss -> forall ann. Doc ann -> Doc ann
braces forall a b. (a -> b) -> a -> b
$ forall ann. [(Fix SexpF, Doc ann)] -> Doc ann
ppList [(Fix SexpF, Doc ann)]
ss
ModifiedF Prefix
q (Fix SexpF, Doc ann)
a ->
case Prefix
q of
Prefix
Quote -> Doc ann
"'" forall a. Semigroup a => a -> a -> a
<> forall a b. (a, b) -> b
snd (Fix SexpF, Doc ann)
a
Prefix
Backtick -> Doc ann
"`" forall a. Semigroup a => a -> a -> a
<> forall a b. (a, b) -> b
snd (Fix SexpF, Doc ann)
a
Prefix
Comma -> Doc ann
"," forall a. Semigroup a => a -> a -> a
<> forall a b. (a, b) -> b
snd (Fix SexpF, Doc ann)
a
Prefix
CommaAt -> Doc ann
",@" forall a. Semigroup a => a -> a -> a
<> forall a b. (a, b) -> b
snd (Fix SexpF, Doc ann)
a
Prefix
Hash -> Doc ann
"#" forall a. Semigroup a => a -> a -> a
<> forall a b. (a, b) -> b
snd (Fix SexpF, Doc ann)
a
instance Pretty (Fix SexpF) where
pretty :: forall ann. Fix SexpF -> Doc ann
pretty = forall ann. Fix SexpF -> Doc ann
ppSexp
format :: Fix SexpF -> ByteString
format :: Fix SexpF -> ByteString
format =
Text -> ByteString
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall ann. SimpleDocStream ann -> Text
Render.renderLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart (PageWidth -> LayoutOptions
LayoutOptions (Int -> Double -> PageWidth
AvailablePerLine Int
79 Double
0.75)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall ann. Fix SexpF -> Doc ann
ppSexp