{-# LANGUAGE FlexibleInstances, OverloadedStrings #-}
module Nixfmt.Pretty where
import Prelude hiding (String)
import Data.Char (isSpace)
import Data.Maybe (fromMaybe)
import Data.Text (Text, isPrefixOf, isSuffixOf, stripPrefix)
import qualified Data.Text as Text
(dropEnd, empty, init, isInfixOf, last, null, strip, takeWhile)
import Nixfmt.Predoc
(Doc, Pretty, base, emptyline, group, hardline, hardspace, hcat, line, line',
nest, newline, pretty, sepBy, softline, softline', text, textWidth)
import Nixfmt.Types
(Ann(..), Binder(..), Expression(..), File(..), Leaf, ParamAttr(..),
Parameter(..), Selector(..), SimpleSelector(..), StringPart(..), Term(..),
Token(..), TrailingComment(..), Trivia, Trivium(..), tokenText)
import Nixfmt.Util (commonIndentation, isSpaces, replaceMultiple)
prettyCommentLine :: Text -> Doc
Text
l
| Text -> Bool
Text.null Text
l = Doc
emptyline
| Bool
otherwise = Text -> Doc
text Text
l Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardline
toLineComment :: Text -> Trivium
Text
c = Text -> Trivium
LineComment (Text -> Trivium) -> Text -> Trivium
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
stripPrefix Text
"*" Text
c
instance Pretty TrailingComment where
pretty :: TrailingComment -> Doc
pretty (TrailingComment Text
c)
= Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text Text
"#" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text Text
c Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardline
instance Pretty Trivium where
pretty :: Trivium -> Doc
pretty Trivium
EmptyLine = Doc
emptyline
pretty (LineComment Text
c) = Text -> Doc
text Text
"#" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
forall a. Pretty a => a -> Doc
pretty Text
c Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardline
pretty (BlockComment [Text]
c)
| (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text
"*" Text -> Text -> Bool
`isPrefixOf`) ([Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
tail [Text]
c) = Trivia -> Doc
forall a. Pretty a => [a] -> Doc
hcat ((Text -> Trivium) -> [Text] -> Trivia
forall a b. (a -> b) -> [a] -> [b]
map Text -> Trivium
toLineComment [Text]
c)
| Bool
otherwise
= Doc -> Doc
base (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> Doc
text Text
"/*" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
3 ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
hcat ((Text -> Doc) -> [Text] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc
prettyCommentLine [Text]
c))
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text Text
"*/" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardline
instance Pretty [Trivium] where
pretty :: Trivia -> Doc
pretty [] = Doc
forall a. Monoid a => a
mempty
pretty Trivia
trivia = Doc
hardline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Trivia -> Doc
forall a. Pretty a => [a] -> Doc
hcat Trivia
trivia
instance Pretty a => Pretty (Ann a) where
pretty :: Ann a -> Doc
pretty (Ann a
x Maybe TrailingComment
trailing Trivia
leading)
= a -> Doc
forall a. Pretty a => a -> Doc
pretty a
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe TrailingComment -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe TrailingComment
trailing Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Trivia -> Doc
forall a. Pretty a => a -> Doc
pretty Trivia
leading
instance Pretty SimpleSelector where
pretty :: SimpleSelector -> Doc
pretty (IDSelector Leaf
i) = Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
i
pretty (InterpolSelector Ann StringPart
interpol) = Ann StringPart -> Doc
forall a. Pretty a => a -> Doc
pretty Ann StringPart
interpol
pretty (StringSelector (Ann [[StringPart]]
s Maybe TrailingComment
trailing Trivia
leading))
= [[StringPart]] -> Doc
prettySimpleString [[StringPart]]
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe TrailingComment -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe TrailingComment
trailing Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Trivia -> Doc
forall a. Pretty a => a -> Doc
pretty Trivia
leading
instance Pretty Selector where
pretty :: Selector -> Doc
pretty (Selector Maybe Leaf
dot SimpleSelector
sel Maybe (Leaf, Term)
Nothing)
= Maybe Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Leaf
dot Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SimpleSelector -> Doc
forall a. Pretty a => a -> Doc
pretty SimpleSelector
sel
pretty (Selector Maybe Leaf
dot SimpleSelector
sel (Just (Leaf
kw, Term
def)))
= Maybe Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Leaf
dot Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SimpleSelector -> Doc
forall a. Pretty a => a -> Doc
pretty SimpleSelector
sel
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
kw Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Term -> Doc
forall a. Pretty a => a -> Doc
pretty Term
def
instance Pretty Binder where
pretty :: Binder -> Doc
pretty (Inherit Leaf
inherit Maybe Term
Nothing [Leaf]
ids Leaf
semicolon)
= Doc -> Doc
base (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
forall a. Pretty a => a -> Doc
group (Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
inherit Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
softline
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 (Doc -> [Leaf] -> Doc
forall a. Pretty a => Doc -> [a] -> Doc
sepBy Doc
softline [Leaf]
ids)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
semicolon
pretty (Inherit Leaf
inherit Maybe Term
source [Leaf]
ids Leaf
semicolon)
= Doc -> Doc
base (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
forall a. Pretty a => a -> Doc
group (Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
inherit Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe Term -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Term
source Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 (Doc -> [Leaf] -> Doc
forall a. Pretty a => Doc -> [a] -> Doc
sepBy Doc
softline [Leaf]
ids)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
semicolon
pretty (Assignment [Selector]
selectors Leaf
assign Expression
expr Leaf
semicolon)
= Doc -> Doc
base (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
forall a. Pretty a => a -> Doc
group ([Selector] -> Doc
forall a. Pretty a => [a] -> Doc
hcat [Selector]
selectors Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 (Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
assign Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
softline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
expr))
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
semicolon
prettyTerm :: Term -> Doc
prettyTerm :: Term -> Doc
prettyTerm (Token Leaf
t) = Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
t
prettyTerm (String String
s) = String -> Doc
forall a. Pretty a => a -> Doc
pretty String
s
prettyTerm (Path Path
p) = Path -> Doc
forall a. Pretty a => a -> Doc
pretty Path
p
prettyTerm (Selection Term
term [Selector]
selectors) = Term -> Doc
forall a. Pretty a => a -> Doc
pretty Term
term Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Selector] -> Doc
forall a. Pretty a => [a] -> Doc
hcat [Selector]
selectors
prettyTerm (List (Ann Token
paropen Maybe TrailingComment
Nothing []) [] Leaf
parclose)
= Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
paropen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
parclose
prettyTerm (List (Ann Token
paropen Maybe TrailingComment
Nothing []) [Term
item] Leaf
parclose)
| Term -> Bool
isAbsorbable Term
item
= Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
paropen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Term -> Doc
forall a. Pretty a => a -> Doc
pretty Term
item Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
parclose
prettyTerm (List (Ann Token
paropen Maybe TrailingComment
trailing Trivia
leading) [Term]
items Leaf
parclose)
= Doc -> Doc
base (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
paropen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe TrailingComment -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe TrailingComment
trailing Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 (Trivia -> Doc
forall a. Pretty a => a -> Doc
pretty Trivia
leading Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> [Doc] -> Doc
forall a. Pretty a => Doc -> [a] -> Doc
sepBy Doc
line ((Term -> Doc) -> [Term] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Term -> Doc
forall a. Pretty a => a -> Doc
group [Term]
items)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
parclose
prettyTerm (Set Maybe Leaf
Nothing (Ann Token
paropen Maybe TrailingComment
Nothing []) [] Leaf
parclose)
= Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
paropen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
parclose
prettyTerm (Set Maybe Leaf
krec (Ann Token
paropen Maybe TrailingComment
trailing Trivia
leading) [Binder]
binders Leaf
parclose)
= Doc -> Doc
base (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Maybe Doc -> Doc
forall a. Pretty a => a -> Doc
pretty ((Leaf -> Doc) -> Maybe Leaf -> Maybe Doc
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>Doc
hardspace) (Doc -> Doc) -> (Leaf -> Doc) -> Leaf -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty) Maybe Leaf
krec)
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
paropen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe TrailingComment -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe TrailingComment
trailing Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 (Trivia -> Doc
forall a. Pretty a => a -> Doc
pretty Trivia
leading Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> [Binder] -> Doc
forall a. Pretty a => Doc -> [a] -> Doc
sepBy Doc
hardline [Binder]
binders) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
parclose
prettyTerm (Parenthesized (Ann Token
paropen Maybe TrailingComment
trailing Trivia
leading) Expression
expr Leaf
parclose)
= Doc -> Doc
base (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
paropen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe TrailingComment -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe TrailingComment
trailing
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 (Trivia -> Doc
forall a. Pretty a => a -> Doc
pretty Trivia
leading Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
forall a. Pretty a => a -> Doc
group Expression
expr) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
parclose
instance Pretty Term where
pretty :: Term -> Doc
pretty l :: Term
l@(List Leaf
_ [Term]
_ Leaf
_) = Doc -> Doc
forall a. Pretty a => a -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Term -> Doc
prettyTerm Term
l
pretty Term
x = Term -> Doc
prettyTerm Term
x
toLeading :: Maybe TrailingComment -> Trivia
toLeading :: Maybe TrailingComment -> Trivia
toLeading Maybe TrailingComment
Nothing = []
toLeading (Just (TrailingComment Text
c)) = [Text -> Trivium
LineComment (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c)]
prettyComma :: Maybe Leaf -> Doc
prettyComma :: Maybe Leaf -> Doc
prettyComma Maybe Leaf
Nothing = Doc
forall a. Monoid a => a
mempty
prettyComma (Just Leaf
comma) = Doc
softline' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
comma Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace
instance Pretty ParamAttr where
pretty :: ParamAttr -> Doc
pretty (ParamAttr Leaf
name Maybe (Leaf, Expression)
Nothing Maybe Leaf
comma)
= Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe Leaf -> Doc
prettyComma Maybe Leaf
comma
pretty (ParamAttr Leaf
name (Just (Leaf
qmark, Expression
def)) Maybe Leaf
comma)
= Doc -> Doc
forall a. Pretty a => a -> Doc
group (Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
qmark
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc -> Maybe Int -> Expression -> Doc
absorb Doc
softline Doc
forall a. Monoid a => a
mempty (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) Expression
def)
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe Leaf -> Doc
prettyComma Maybe Leaf
comma
pretty (ParamEllipsis Leaf
ellipsis)
= Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
ellipsis
instance Pretty Parameter where
pretty :: Parameter -> Doc
pretty (IDParameter Leaf
i) = Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
i
pretty (SetParameter Leaf
bopen [ParamAttr]
attrs Leaf
bclose)
= Doc -> Doc
forall a. Pretty a => a -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
bopen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [ParamAttr] -> Doc
forall a. Pretty a => [a] -> Doc
hcat [ParamAttr]
attrs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
softline
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
bclose
pretty (ContextParameter Parameter
param1 Leaf
at Parameter
param2)
= Parameter -> Doc
forall a. Pretty a => a -> Doc
pretty Parameter
param1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
at Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Parameter -> Doc
forall a. Pretty a => a -> Doc
pretty Parameter
param2
isAbsorbable :: Term -> Bool
isAbsorbable :: Term -> Bool
isAbsorbable (String (Ann parts :: [[StringPart]]
parts@([StringPart]
_:[StringPart]
_:[[StringPart]]
_) Maybe TrailingComment
_ Trivia
_))
= Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [[StringPart]] -> Bool
isSimpleString [[StringPart]]
parts
isAbsorbable (Set Maybe Leaf
_ Leaf
_ (Binder
_:[Binder]
_) Leaf
_) = Bool
True
isAbsorbable (List (Ann Token
_ Maybe TrailingComment
Nothing []) [Term
item] Leaf
_) = Term -> Bool
isAbsorbable Term
item
isAbsorbable (Parenthesized (Ann Token
_ Maybe TrailingComment
Nothing []) (Term Term
t) Leaf
_) = Term -> Bool
isAbsorbable Term
t
isAbsorbable (List Leaf
_ (Term
_:Term
_:[Term]
_) Leaf
_) = Bool
True
isAbsorbable Term
_ = Bool
False
absorb :: Doc -> Doc -> Maybe Int -> Expression -> Doc
absorb :: Doc -> Doc -> Maybe Int -> Expression -> Doc
absorb Doc
left Doc
right Maybe Int
_ (Term Term
t)
| Term -> Bool
isAbsorbable Term
t = Doc -> Doc
toHardspace Doc
left Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Term -> Doc
prettyTerm Term
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
toHardspace Doc
right
where toHardspace :: Doc -> Doc
toHardspace Doc
x | Doc
x Doc -> Doc -> Bool
forall a. Eq a => a -> a -> Bool
== Doc
forall a. Monoid a => a
mempty = Doc
forall a. Monoid a => a
mempty
| Doc
x Doc -> Doc -> Bool
forall a. Eq a => a -> a -> Bool
== Doc
softline' = Doc
forall a. Monoid a => a
mempty
| Doc
x Doc -> Doc -> Bool
forall a. Eq a => a -> a -> Bool
== Doc
line' = Doc
forall a. Monoid a => a
mempty
| Bool
otherwise = Doc
hardspace
absorb Doc
left Doc
right Maybe Int
Nothing Expression
x = Doc
left Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
right
absorb Doc
left Doc
right (Just Int
level) Expression
x
= Doc
left Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
level (Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
x) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
right
absorbSet :: Expression -> Doc
absorbSet :: Expression -> Doc
absorbSet = Doc -> Doc -> Maybe Int -> Expression -> Doc
absorb Doc
line Doc
forall a. Monoid a => a
mempty Maybe Int
forall a. Maybe a
Nothing
absorbThen :: Expression -> Doc
absorbThen :: Expression -> Doc
absorbThen (Term Term
t) | Term -> Bool
isAbsorbable Term
t = Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Term -> Doc
prettyTerm Term
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace
absorbThen Expression
x = Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 (Expression -> Doc
forall a. Pretty a => a -> Doc
group Expression
x) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line
absorbElse :: Expression -> Doc
absorbElse :: Expression -> Doc
absorbElse (If Leaf
if_ Expression
cond Leaf
then_ Expression
expr0 Leaf
else_ Expression
expr1)
= Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
if_ Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
forall a. Pretty a => a -> Doc
group Expression
cond Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
then_ Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
absorbThen Expression
expr0
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
else_ Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
absorbElse Expression
expr1
absorbElse (Term Term
t) | Term -> Bool
isAbsorbable Term
t = Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Term -> Doc
prettyTerm Term
t
absorbElse Expression
x = Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 (Expression -> Doc
forall a. Pretty a => a -> Doc
group Expression
x)
absorbApp :: Expression -> Doc
absorbApp :: Expression -> Doc
absorbApp (Application Expression
f Expression
x) = Doc
softline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
absorbApp Expression
x
absorbApp (Term Term
t) | Term -> Bool
isAbsorbable Term
t = Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
forall a. Pretty a => a -> Doc
group (Term -> Doc
prettyTerm Term
t)
absorbApp Expression
x = Doc
softline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
x
instance Pretty Expression where
pretty :: Expression -> Doc
pretty (Term Term
t) = Term -> Doc
forall a. Pretty a => a -> Doc
pretty Term
t
pretty (With Leaf
with Expression
expr0 Leaf
semicolon Expression
expr1)
= Doc -> Doc
base (Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
with Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 (Expression -> Doc
forall a. Pretty a => a -> Doc
group Expression
expr0) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
semicolon)
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
absorbSet Expression
expr1
pretty (Let (Ann Token
let_ Maybe TrailingComment
letTrailing Trivia
letLeading) [Binder]
binders
(Ann Token
in_ Maybe TrailingComment
inTrailing Trivia
inLeading) Expression
expr)
= Doc -> Doc
base (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
forall a. Pretty a => a -> Doc
group Doc
letPart Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
forall a. Pretty a => a -> Doc
group Doc
inPart
where letPart :: Doc
letPart = Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
let_ Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe TrailingComment -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe TrailingComment
letTrailing Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
letBody
inPart :: Doc
inPart = Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
in_ Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
expr
letBody :: Doc
letBody = Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Trivia -> Doc
forall a. Pretty a => a -> Doc
pretty Trivia
letLeading
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> [Binder] -> Doc
forall a. Pretty a => Doc -> [a] -> Doc
sepBy Doc
hardline [Binder]
binders
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Trivia -> Doc
forall a. Pretty a => a -> Doc
pretty (Maybe TrailingComment -> Trivia
toLeading Maybe TrailingComment
inTrailing)
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Trivia -> Doc
forall a. Pretty a => a -> Doc
pretty Trivia
inLeading
pretty (Assert Leaf
assert Expression
cond Leaf
semicolon Expression
expr)
= Doc -> Doc
base (Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
assert Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 (Expression -> Doc
forall a. Pretty a => a -> Doc
group Expression
cond) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
semicolon)
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
absorbSet Expression
expr
pretty (If Leaf
if_ Expression
cond Leaf
then_ Expression
expr0 Leaf
else_ Expression
expr1)
= Doc -> Doc
base (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
forall a. Pretty a => a -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
if_ Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
forall a. Pretty a => a -> Doc
group Expression
cond Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
then_ Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
absorbThen Expression
expr0
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
else_ Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
absorbElse Expression
expr1
pretty (Abstraction (IDParameter Leaf
param) Leaf
colon Expression
body)
= Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
param Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
absorbAbs Expression
body
where absorbAbs :: Expression -> Doc
absorbAbs (Abstraction (IDParameter Leaf
param0) Leaf
colon0 Expression
body0) =
Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
param0 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
colon0 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
absorbAbs Expression
body0
absorbAbs Expression
x = Expression -> Doc
absorbSet Expression
x
pretty (Abstraction Parameter
param Leaf
colon Expression
body)
= Parameter -> Doc
forall a. Pretty a => a -> Doc
pretty Parameter
param Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
absorbSet Expression
body
pretty (Application Expression
f Expression
x) = Doc -> Doc
forall a. Pretty a => a -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
absorbApp Expression
x
pretty (Operation Expression
a Leaf
op Expression
b)
= Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
a Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
softline
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
op Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
b
pretty (MemberCheck Expression
expr Leaf
qmark [Selector]
sel)
= Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
expr Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
softline
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
qmark Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardspace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Selector] -> Doc
forall a. Pretty a => [a] -> Doc
hcat [Selector]
sel
pretty (Negation Leaf
minus Expression
expr)
= Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
minus Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
expr
pretty (Inversion Leaf
bang Expression
expr)
= Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
bang Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
expr
instance Pretty File where
pretty :: File -> Doc
pretty (File (Ann Token
_ Maybe TrailingComment
Nothing Trivia
leading) Expression
expr)
= Doc -> Doc
forall a. Pretty a => a -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Trivia -> Doc
forall a. Pretty a => [a] -> Doc
hcat Trivia
leading Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
expr Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardline
pretty (File (Ann Token
_ (Just (TrailingComment Text
trailing)) Trivia
leading) Expression
expr)
= Doc -> Doc
forall a. Pretty a => a -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> Doc
text Text
"# " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
forall a. Pretty a => a -> Doc
pretty Text
trailing Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardline
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Trivia -> Doc
forall a. Pretty a => [a] -> Doc
hcat Trivia
leading Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
expr Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
hardline
instance Pretty Token where
pretty :: Token -> Doc
pretty = Text -> Doc
text (Text -> Doc) -> (Token -> Text) -> Token -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Text
tokenText
instance Pretty [Token] where
pretty :: [Token] -> Doc
pretty = [Token] -> Doc
forall a. Pretty a => [a] -> Doc
hcat
isSimpleSelector :: Selector -> Bool
isSimpleSelector :: Selector -> Bool
isSimpleSelector (Selector Maybe Leaf
_ (IDSelector Leaf
_) Maybe (Leaf, Term)
Nothing) = Bool
True
isSimpleSelector Selector
_ = Bool
False
isSimple :: Expression -> Bool
isSimple :: Expression -> Bool
isSimple (Term (Token (Ann (Identifier Text
_) Maybe TrailingComment
Nothing []))) = Bool
True
isSimple (Term (Selection Term
t [Selector]
selectors))
= Expression -> Bool
isSimple (Term -> Expression
Term Term
t) Bool -> Bool -> Bool
&& (Selector -> Bool) -> [Selector] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Selector -> Bool
isSimpleSelector [Selector]
selectors
isSimple Expression
_ = Bool
False
hasQuotes :: [StringPart] -> Bool
hasQuotes :: [StringPart] -> Bool
hasQuotes [] = Bool
False
hasQuotes (TextPart Text
x : [StringPart]
xs) = Text -> Text -> Bool
Text.isInfixOf Text
"\"" Text
x Bool -> Bool -> Bool
|| [StringPart] -> Bool
hasQuotes [StringPart]
xs
hasQuotes (StringPart
_ : [StringPart]
xs) = [StringPart] -> Bool
hasQuotes [StringPart]
xs
hasDualQuotes :: [StringPart] -> Bool
hasDualQuotes :: [StringPart] -> Bool
hasDualQuotes [] = Bool
False
hasDualQuotes (TextPart Text
x : [StringPart]
xs) = Text -> Text -> Bool
Text.isInfixOf Text
"''" Text
x Bool -> Bool -> Bool
|| [StringPart] -> Bool
hasDualQuotes [StringPart]
xs
hasDualQuotes (StringPart
_ : [StringPart]
xs) = [StringPart] -> Bool
hasDualQuotes [StringPart]
xs
endsInSingleQuote :: [StringPart] -> Bool
endsInSingleQuote :: [StringPart] -> Bool
endsInSingleQuote [] = Bool
False
endsInSingleQuote [StringPart]
xs =
case [StringPart] -> StringPart
forall a. HasCallStack => [a] -> a
last [StringPart]
xs of
(TextPart Text
x) -> Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
Text.empty Bool -> Bool -> Bool
&& HasCallStack => Text -> Char
Text -> Char
Text.last Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''
StringPart
_ -> Bool
False
isIndented :: [[StringPart]] -> Bool
isIndented :: [[StringPart]] -> Bool
isIndented [[StringPart]]
parts =
case [Text] -> Maybe Text
commonIndentation [Text]
inits of
Just Text
"" -> Bool
False
Maybe Text
_ -> Bool
True
where textInit :: [StringPart] -> Text
textInit (TextPart Text
t : [StringPart]
xs) = Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [StringPart] -> Text
textInit [StringPart]
xs
textInit [StringPart]
_ = Text
""
nonEmpty :: [StringPart] -> Bool
nonEmpty (TextPart Text
"" : [StringPart]
xs) = [StringPart] -> Bool
nonEmpty [StringPart]
xs
nonEmpty [] = Bool
False
nonEmpty [StringPart]
_ = Bool
True
inits :: [Text]
inits = ([StringPart] -> Text) -> [[StringPart]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [StringPart] -> Text
textInit ([[StringPart]] -> [Text]) -> [[StringPart]] -> [Text]
forall a b. (a -> b) -> a -> b
$ ([StringPart] -> Bool) -> [[StringPart]] -> [[StringPart]]
forall a. (a -> Bool) -> [a] -> [a]
filter [StringPart] -> Bool
nonEmpty [[StringPart]]
parts
lastLineIsSpaces :: [[StringPart]] -> Bool
lastLineIsSpaces :: [[StringPart]] -> Bool
lastLineIsSpaces [] = Bool
False
lastLineIsSpaces [[StringPart]]
xs = case [[StringPart]] -> [StringPart]
forall a. HasCallStack => [a] -> a
last [[StringPart]]
xs of
[TextPart Text
t] -> Text -> Bool
isSpaces Text
t
[StringPart]
_ -> Bool
False
isInvisibleLine :: [StringPart] -> Bool
isInvisibleLine :: [StringPart] -> Bool
isInvisibleLine [] = Bool
True
isInvisibleLine [TextPart Text
t] = Text -> Bool
Text.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.strip Text
t
isInvisibleLine [StringPart]
_ = Bool
False
isSimpleString :: [[StringPart]] -> Bool
isSimpleString :: [[StringPart]] -> Bool
isSimpleString [[StringPart]
parts]
| [StringPart] -> Bool
hasDualQuotes [StringPart]
parts = Bool
True
| [StringPart] -> Bool
endsInSingleQuote [StringPart]
parts = Bool
True
| [[StringPart]] -> Bool
isIndented [[StringPart]
parts] = Bool
True
| [StringPart] -> Bool
hasQuotes [StringPart]
parts = Bool
False
| Bool
otherwise = Bool
True
isSimpleString [[StringPart]]
parts
| ([StringPart] -> Bool) -> [[StringPart]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [StringPart] -> Bool
isInvisibleLine [[StringPart]]
parts = Bool
True
| [[StringPart]] -> Bool
isIndented [[StringPart]]
parts = Bool
True
| [[StringPart]] -> Bool
lastLineIsSpaces [[StringPart]]
parts = Bool
True
| Bool
otherwise = Bool
False
instance Pretty StringPart where
pretty :: StringPart -> Doc
pretty (TextPart Text
t) = Text -> Doc
text Text
t
pretty (Interpolation Leaf
paropen (Term Term
t) Token
parclose)
| Term -> Bool
isAbsorbable Term
t
= Doc -> Doc
forall a. Pretty a => a -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
paropen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Term -> Doc
prettyTerm Term
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
parclose
pretty (Interpolation Leaf
paropen Expression
expr Token
parclose)
| Expression -> Bool
isSimple Expression
expr
= Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
paropen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
expr Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
parclose
| Bool
otherwise
= Doc -> Doc
forall a. Pretty a => a -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
paropen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line'
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 (Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
expr) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line'
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
parclose
instance Pretty [StringPart] where
pretty :: [StringPart] -> Doc
pretty [Interpolation Leaf
paropen Expression
expr Token
parclose]
= Doc -> Doc
forall a. Pretty a => a -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
paropen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Expression -> Doc
forall a. Pretty a => a -> Doc
pretty Expression
expr Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Token -> Doc
forall a. Pretty a => a -> Doc
pretty Token
parclose
pretty (TextPart Text
t : [StringPart]
parts)
= Text -> Doc
text Text
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
indentation ([StringPart] -> Doc
forall a. Pretty a => [a] -> Doc
hcat [StringPart]
parts)
where indentation :: Int
indentation = Text -> Int
textWidth (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
Text.takeWhile Char -> Bool
isSpace Text
t
pretty [StringPart]
parts = [StringPart] -> Doc
forall a. Pretty a => [a] -> Doc
hcat [StringPart]
parts
instance Pretty [[StringPart]] where
pretty :: [[StringPart]] -> Doc
pretty [[StringPart]]
parts
| [[StringPart]] -> Bool
isSimpleString [[StringPart]]
parts = [[StringPart]] -> Doc
prettySimpleString [[StringPart]]
parts
| Bool
otherwise = [[StringPart]] -> Doc
prettyIndentedString [[StringPart]]
parts
type UnescapeInterpol = Text -> Text
type EscapeText = Text -> Text
prettyLine :: EscapeText -> UnescapeInterpol -> [StringPart] -> Doc
prettyLine :: (Text -> Text) -> (Text -> Text) -> [StringPart] -> Doc
prettyLine Text -> Text
escapeText Text -> Text
unescapeInterpol
= [StringPart] -> Doc
forall a. Pretty a => a -> Doc
pretty ([StringPart] -> Doc)
-> ([StringPart] -> [StringPart]) -> [StringPart] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StringPart] -> [StringPart]
unescapeInterpols ([StringPart] -> [StringPart])
-> ([StringPart] -> [StringPart]) -> [StringPart] -> [StringPart]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StringPart -> StringPart) -> [StringPart] -> [StringPart]
forall a b. (a -> b) -> [a] -> [b]
map StringPart -> StringPart
escape
where escape :: StringPart -> StringPart
escape (TextPart Text
t) = Text -> StringPart
TextPart (Text -> Text
escapeText Text
t)
escape StringPart
x = StringPart
x
unescapeInterpols :: [StringPart] -> [StringPart]
unescapeInterpols [] = []
unescapeInterpols (TextPart Text
t : TextPart Text
u : [StringPart]
xs)
= [StringPart] -> [StringPart]
unescapeInterpols (Text -> StringPart
TextPart (Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
u) StringPart -> [StringPart] -> [StringPart]
forall a. a -> [a] -> [a]
: [StringPart]
xs)
unescapeInterpols (TextPart Text
t : xs :: [StringPart]
xs@(Interpolation Leaf
_ Expression
_ Token
_ : [StringPart]
_))
= Text -> StringPart
TextPart (Text -> Text
unescapeInterpol Text
t) StringPart -> [StringPart] -> [StringPart]
forall a. a -> [a] -> [a]
: [StringPart] -> [StringPart]
unescapeInterpols [StringPart]
xs
unescapeInterpols (StringPart
x : [StringPart]
xs) = StringPart
x StringPart -> [StringPart] -> [StringPart]
forall a. a -> [a] -> [a]
: [StringPart] -> [StringPart]
unescapeInterpols [StringPart]
xs
prettySimpleString :: [[StringPart]] -> Doc
prettySimpleString :: [[StringPart]] -> Doc
prettySimpleString [[StringPart]]
parts = Doc -> Doc
forall a. Pretty a => a -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Text -> Doc
text Text
"\""
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> [Doc] -> Doc
forall a. Pretty a => Doc -> [a] -> Doc
sepBy (Text -> Doc
text Text
"\\n") (([StringPart] -> Doc) -> [[StringPart]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text) -> (Text -> Text) -> [StringPart] -> Doc
prettyLine Text -> Text
escape Text -> Text
unescapeInterpol) [[StringPart]]
parts)
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text Text
"\""
where escape :: Text -> Text
escape = [(Text, Text)] -> Text -> Text
replaceMultiple
[ (Text
"$\\${", Text
"$${")
, (Text
"${", Text
"\\${")
, (Text
"\"", Text
"\\\"")
, (Text
"\r", Text
"\\r")
, (Text
"\\", Text
"\\\\")
]
unescapeInterpol :: Text -> Text
unescapeInterpol Text
t
| Text
"$" Text -> Text -> Bool
`isSuffixOf` Text
t = HasCallStack => Text -> Text
Text -> Text
Text.init Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\$"
| Bool
otherwise = Text
t
prettyIndentedString :: [[StringPart]] -> Doc
prettyIndentedString :: [[StringPart]] -> Doc
prettyIndentedString [[StringPart]]
parts = Doc -> Doc
forall a. Pretty a => a -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
base (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Text -> Doc
text Text
"''" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line'
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 (Doc -> [Doc] -> Doc
forall a. Pretty a => Doc -> [a] -> Doc
sepBy Doc
newline (([StringPart] -> Doc) -> [[StringPart]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text) -> (Text -> Text) -> [StringPart] -> Doc
prettyLine Text -> Text
escape Text -> Text
unescapeInterpol) [[StringPart]]
parts))
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text Text
"''"
where escape :: Text -> Text
escape = [(Text, Text)] -> Text -> Text
replaceMultiple
[ (Text
"'${", Text
"''\\'''${")
, (Text
"${", Text
"''${")
, (Text
"''", Text
"'''")
]
unescapeInterpol :: Text -> Text
unescapeInterpol Text
t
| Text -> Bool
Text.null Text
t = Text
t
| HasCallStack => Text -> Char
Text -> Char
Text.last Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'$' = Text
t
| Text -> Int
trailingQuotes (HasCallStack => Text -> Text
Text -> Text
Text.init Text
t) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
= HasCallStack => Text -> Text
Text -> Text
Text.init Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"''$"
| Text -> Int
trailingQuotes (HasCallStack => Text -> Text
Text -> Text
Text.init Text
t) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
= Int -> Text -> Text
Text.dropEnd Int
2 Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"''\\'''$"
| Bool
otherwise
= [Char] -> Text
forall a. HasCallStack => [Char] -> a
error [Char]
"should never happen after escape"
trailingQuotes :: Text -> Int
trailingQuotes Text
t
| Text
"'" Text -> Text -> Bool
`isSuffixOf` Text
t = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
trailingQuotes (HasCallStack => Text -> Text
Text -> Text
Text.init Text
t)
| Bool
otherwise = Int
0 :: Int