{- © 2019 Serokell <hi@serokell.io>
 - © 2019 Lars Jellema <lars.jellema@gmail.com>
 -
 - SPDX-License-Identifier: MPL-2.0
 -}

{-# LANGUAGE FlexibleInstances, LambdaCase, 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, replace, 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
prettyCommentLine :: Text -> Doc
prettyCommentLine 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
toLineComment :: Text -> Trivium
toLineComment 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. [a] -> [a]
tail [Text]
c) = [Trivium] -> Doc
forall a. Pretty a => [a] -> Doc
hcat ((Text -> Trivium) -> [Text] -> [Trivium]
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 :: [Trivium] -> Doc
pretty []     = Doc
forall a. Monoid a => a
mempty
    pretty [Trivium]
trivia = Doc
hardline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Trivium] -> Doc
forall a. Pretty a => [a] -> Doc
hcat [Trivium]
trivia

instance Pretty a => Pretty (Ann a) where
    pretty :: Ann a -> Doc
pretty (Ann a
x Maybe TrailingComment
trailing [Trivium]
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
<> [Trivium] -> Doc
forall a. Pretty a => a -> Doc
pretty [Trivium]
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 [Trivium]
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
<> [Trivium] -> Doc
forall a. Pretty a => a -> Doc
pretty [Trivium]
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

-- | Pretty print a term without wrapping it in a group.
prettyTerm :: Term -> Doc
prettyTerm :: Term -> Doc
prettyTerm (Token Leaf
t) = Leaf -> Doc
forall a. Pretty a => a -> Doc
pretty Leaf
t
prettyTerm (String Ann [[StringPart]]
s) = Ann [[StringPart]] -> Doc
forall a. Pretty a => a -> Doc
pretty Ann [[StringPart]]
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 [Trivium]
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 ([Trivium] -> Doc
forall a. Pretty a => a -> Doc
pretty [Trivium]
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 [Trivium]
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 (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 ([Trivium] -> Doc
forall a. Pretty a => a -> Doc
pretty [Trivium]
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 [Trivium]
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 ([Trivium] -> Doc
forall a. Pretty a => a -> Doc
pretty [Trivium]
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 -> [Trivium]
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
_ [Trivium]
_))
    = 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 [Trivium]
letLeading) [Binder]
binders
                (Ann Token
in_ Maybe TrailingComment
inTrailing [Trivium]
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
$
                  [Trivium] -> Doc
forall a. Pretty a => a -> Doc
pretty [Trivium]
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
<> [Trivium] -> Doc
forall a. Pretty a => a -> Doc
pretty (Maybe TrailingComment -> [Trivium]
toLeading Maybe TrailingComment
inTrailing)
                  Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Trivium] -> Doc
forall a. Pretty a => a -> Doc
pretty [Trivium]
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 [Trivium]
leading) Expression
expr)
        = Doc -> Doc
forall a. Pretty a => a -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Trivium] -> Doc
forall a. Pretty a => [a] -> Doc
hcat [Trivium]
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)) [Trivium]
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
<> [Trivium] -> Doc
forall a. Pretty a => [a] -> Doc
hcat [Trivium]
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

-- STRINGS

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. [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
&& 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

-- | If the last line has at least one space but nothing else, it cannot be
-- cleanly represented in an indented string.
lastLineIsSpaces :: [[StringPart]] -> Bool
lastLineIsSpaces :: [[StringPart]] -> Bool
lastLineIsSpaces [] = Bool
False
lastLineIsSpaces [[StringPart]]
xs = case [[StringPart]] -> [StringPart]
forall a. [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
Text.replace Text
"$\\${" Text
"$${"
              (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
Text.replace Text
"${" Text
"\\${"
              (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
Text.replace Text
"\"" Text
"\\\""
              (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
Text.replace Text
"\r" Text
"\\r"
              (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
Text.replace Text
"\\" Text
"\\\\"

          unescapeInterpol :: Text -> Text
unescapeInterpol Text
t
              | Text
"$" Text -> Text -> Bool
`isSuffixOf` Text
t = 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
              | Text -> Char
Text.last Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'$' = Text
t
              | Text -> Int
trailingQuotes (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
                  = Text -> Text
Text.init Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"''$"
              | Text -> Int
trailingQuotes (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 (Text -> Text
Text.init Text
t)
              | Bool
otherwise          = Int
0 :: Int