{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

{-# OPTIONS_GHC -Wall #-}

{-| This module provides internal pretty-printing utilities which are used by
    other modules but are not part of the public facing API
-}

module Dhall.Pretty.Internal (
      Ann(..)
    , annToAnsiStyle
    , prettyExpr
    , prettySrcExpr

    , CharacterSet(..)
    , prettyCharacterSet

    , prettyVar
    , pretty_
    , escapeText_
    , escapeEnvironmentVariable
    , prettyEnvironmentVariable

    , prettyConst
    , escapeLabel
    , prettyLabel
    , prettyAnyLabel
    , prettyLabels
    , prettyNatural
    , prettyNumber
    , prettyInt
    , prettyDouble
    , prettyToStrictText
    , prettyToString
    , layout
    , layoutOpts

    , docToStrictText

    , builtin
    , keyword
    , literal
    , operator

    , colon
    , comma
    , dot
    , equals
    , forall
    , label
    , lambda
    , langle
    , lbrace
    , lbracket
    , lparen
    , pipe
    , rangle
    , rarrow
    , rbrace
    , rbracket
    , rparen
    ) where

import Data.Foldable
import Data.List.NonEmpty        (NonEmpty (..))
import Data.Monoid               ((<>))
import Data.Text                 (Text)
import Data.Text.Prettyprint.Doc (Doc, Pretty, space)
import Dhall.Map                 (Map)
import Dhall.Set                 (Set)
import Dhall.Src                 (Src (..))
import Dhall.Syntax
import Numeric.Natural           (Natural)
import Prelude                   hiding (succ)

import qualified Data.Char
import qualified Data.HashSet
import qualified Data.List
import qualified Data.List.NonEmpty                        as NonEmpty
import qualified Data.Set
import qualified Data.Text                                 as Text
import qualified Data.Text.Prettyprint.Doc                 as Pretty
import qualified Data.Text.Prettyprint.Doc.Render.String   as Pretty
import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Terminal
import qualified Data.Text.Prettyprint.Doc.Render.Text     as Pretty
import qualified Dhall.Map                                 as Map
import qualified Dhall.Set

{-| Annotation type used to tag elements in a pretty-printed document for
    syntax highlighting purposes
-}
data Ann
  = Keyword     -- ^ Used for syntactic keywords
  | Syntax      -- ^ Syntax punctuation such as commas, parenthesis, and braces
  | Label       -- ^ Record labels
  | Literal     -- ^ Literals such as integers and strings
  | Builtin     -- ^ Builtin types and values
  | Operator    -- ^ Operators
  deriving Int -> Ann -> ShowS
[Ann] -> ShowS
Ann -> String
(Int -> Ann -> ShowS)
-> (Ann -> String) -> ([Ann] -> ShowS) -> Show Ann
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ann] -> ShowS
$cshowList :: [Ann] -> ShowS
show :: Ann -> String
$cshow :: Ann -> String
showsPrec :: Int -> Ann -> ShowS
$cshowsPrec :: Int -> Ann -> ShowS
Show

{-| Convert annotations to their corresponding color for syntax highlighting
    purposes
-}
annToAnsiStyle :: Ann -> Terminal.AnsiStyle
annToAnsiStyle :: Ann -> AnsiStyle
annToAnsiStyle Ann
Keyword  = AnsiStyle
Terminal.bold AnsiStyle -> AnsiStyle -> AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Color -> AnsiStyle
Terminal.colorDull Color
Terminal.Green
annToAnsiStyle Ann
Syntax   = AnsiStyle
Terminal.bold AnsiStyle -> AnsiStyle -> AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Color -> AnsiStyle
Terminal.colorDull Color
Terminal.Green
annToAnsiStyle Ann
Label    = AnsiStyle
forall a. Monoid a => a
mempty
annToAnsiStyle Ann
Literal  = Color -> AnsiStyle
Terminal.colorDull Color
Terminal.Magenta
annToAnsiStyle Ann
Builtin  = AnsiStyle
Terminal.underlined
annToAnsiStyle Ann
Operator = AnsiStyle
Terminal.bold AnsiStyle -> AnsiStyle -> AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Color -> AnsiStyle
Terminal.colorDull Color
Terminal.Green

-- | This type determines whether to render code as `ASCII` or `Unicode`
data CharacterSet = ASCII | Unicode deriving Int -> CharacterSet -> ShowS
[CharacterSet] -> ShowS
CharacterSet -> String
(Int -> CharacterSet -> ShowS)
-> (CharacterSet -> String)
-> ([CharacterSet] -> ShowS)
-> Show CharacterSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharacterSet] -> ShowS
$cshowList :: [CharacterSet] -> ShowS
show :: CharacterSet -> String
$cshow :: CharacterSet -> String
showsPrec :: Int -> CharacterSet -> ShowS
$cshowsPrec :: Int -> CharacterSet -> ShowS
Show

-- | Pretty print an expression
prettyExpr :: Pretty a => Expr s a -> Doc Ann
prettyExpr :: Expr s a -> Doc Ann
prettyExpr = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettySrcExpr (Expr Src a -> Doc Ann)
-> (Expr s a -> Expr Src a) -> Expr s a -> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr s a -> Expr Src a
forall s a t. Expr s a -> Expr t a
denote

prettySrcExpr :: Pretty a => Expr Src a -> Doc Ann
prettySrcExpr :: Expr Src a -> Doc Ann
prettySrcExpr = CharacterSet -> Expr Src a -> Doc Ann
forall a. Pretty a => CharacterSet -> Expr Src a -> Doc Ann
prettyCharacterSet CharacterSet
Unicode

{-| Internal utility for pretty-printing, used when generating element lists
    to supply to `enclose` or `enclose'`.  This utility indicates that the
    compact represent is the same as the multi-line representation for each
    element
-}
duplicate :: a -> (a, a)
duplicate :: a -> (a, a)
duplicate a
x = (a
x, a
x)

isWhitespace :: Char -> Bool
isWhitespace :: Char -> Bool
isWhitespace Char
c =
    case Char
c of
        Char
' '  -> Bool
True
        Char
'\n' -> Bool
True
        Char
'\t' -> Bool
True
        Char
'\r' -> Bool
True
        Char
_    -> Bool
False

{-| Used to render inline `Src` spans preserved by the syntax tree

    >>> let unusedSourcePos = Text.Megaparsec.SourcePos "" (Text.Megaparsec.mkPos 1) (Text.Megaparsec.mkPos 1)
    >>> let nonEmptySrc = Src unusedSourcePos unusedSourcePos "-- Documentation for x\n"
    >>> "let" <> " " <> renderSrc id (Just nonEmptySrc) <> "x = 1 in x"
    let -- Documentation for x
        x = 1 in x
    >>> let emptySrc = Src unusedSourcePos unusedSourcePos "      "
    >>> "let" <> " " <> renderSrc id (Just emptySrc) <> "x = 1 in x"
    let x = 1 in x
    >>> "let" <> " " <> renderSrc id Nothing <> "x = 1 in x"
    let x = 1 in x
-}
renderSrc
    :: (Text -> Text)
    -- ^ Used to preprocess the comment string (e.g. to strip whitespace)
    -> Maybe Src
    -- ^ Source span to render (if present)
    -> Doc Ann
renderSrc :: (Text -> Text) -> Maybe Src -> Doc Ann
renderSrc Text -> Text
strip (Just (Src {Text
SourcePos
srcText :: Src -> Text
srcEnd :: Src -> SourcePos
srcStart :: Src -> SourcePos
srcText :: Text
srcEnd :: SourcePos
srcStart :: SourcePos
..}))
    | Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isWhitespace Text
srcText) =
        Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align ((Doc Ann -> Doc Ann -> Doc Ann) -> [Doc Ann] -> Doc Ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
Pretty.concatWith Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
f [Doc Ann]
forall ann. [Doc ann]
newLines Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
suffix)
  where
    horizontalSpace :: Char -> Bool
horizontalSpace Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'

    strippedText :: Text
strippedText = Text -> Text
strip Text
srcText

    suffix :: Doc Ann
suffix =
        if Text -> Bool
Text.null Text
strippedText
        then Doc Ann
forall a. Monoid a => a
mempty
        else if Text -> Char
Text.last Text
strippedText Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then Doc Ann
forall a. Monoid a => a
mempty else Doc Ann
" "

    oldLines :: [Text]
oldLines = Text -> Text -> [Text]
Text.splitOn Text
"\n" Text
strippedText

    spacePrefix :: Text -> Text
spacePrefix = (Char -> Bool) -> Text -> Text
Text.takeWhile Char -> Bool
horizontalSpace

    commonPrefix :: Text -> Text -> Text
commonPrefix Text
a Text
b = case Text -> Text -> Maybe (Text, Text, Text)
Text.commonPrefixes Text
a Text
b of
        Maybe (Text, Text, Text)
Nothing        -> Text
""
        Just (Text
c, Text
_, Text
_) -> Text
c

    sharedSpacePrefix :: [Text] -> Text
sharedSpacePrefix []       = Text
""
    sharedSpacePrefix (Text
l : [Text]
ls) = (Text -> Text -> Text) -> Text -> [Text] -> Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Text -> Text -> Text
commonPrefix (Text -> Text
spacePrefix Text
l) [Text]
ls

    blank :: Text -> Bool
blank = (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
horizontalSpace

    newLines :: [Doc ann]
newLines =
        case [Text]
oldLines of
            [] ->
               []
            Text
l0 : [Text]
ls ->
                let sharedPrefix :: Text
sharedPrefix =
                        [Text] -> Text
sharedSpacePrefix ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
blank) [Text]
ls)

                    perLine :: Text -> Doc ann
perLine Text
l =
                        case Text -> Text -> Maybe Text
Text.stripPrefix Text
sharedPrefix Text
l of
                            Maybe Text
Nothing -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
l
                            Just Text
l' -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
l'

                in  Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
l0 Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall ann. Text -> Doc ann
perLine [Text]
ls

    f :: Doc ann -> Doc ann -> Doc ann
f Doc ann
x Doc ann
y = Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
Pretty.hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
y
renderSrc Text -> Text
_ Maybe Src
_ =
    Doc Ann
forall a. Monoid a => a
mempty

-- Annotation helpers
keyword, syntax, label, literal, builtin, operator :: Doc Ann -> Doc Ann
keyword :: Doc Ann -> Doc Ann
keyword  = Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Keyword
syntax :: Doc Ann -> Doc Ann
syntax   = Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Syntax
label :: Doc Ann -> Doc Ann
label    = Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Label
literal :: Doc Ann -> Doc Ann
literal  = Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Literal
builtin :: Doc Ann -> Doc Ann
builtin  = Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Builtin
operator :: Doc Ann -> Doc Ann
operator = Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Operator

comma, lbracket, rbracket, langle, rangle, lbrace, rbrace, lparen, rparen, pipe, dollar, colon, equals, dot :: Doc Ann
comma :: Doc Ann
comma    = Doc Ann -> Doc Ann
syntax Doc Ann
forall ann. Doc ann
Pretty.comma
lbracket :: Doc Ann
lbracket = Doc Ann -> Doc Ann
syntax Doc Ann
forall ann. Doc ann
Pretty.lbracket
rbracket :: Doc Ann
rbracket = Doc Ann -> Doc Ann
syntax Doc Ann
forall ann. Doc ann
Pretty.rbracket
langle :: Doc Ann
langle   = Doc Ann -> Doc Ann
syntax Doc Ann
forall ann. Doc ann
Pretty.langle
rangle :: Doc Ann
rangle   = Doc Ann -> Doc Ann
syntax Doc Ann
forall ann. Doc ann
Pretty.rangle
lbrace :: Doc Ann
lbrace   = Doc Ann -> Doc Ann
syntax Doc Ann
forall ann. Doc ann
Pretty.lbrace
rbrace :: Doc Ann
rbrace   = Doc Ann -> Doc Ann
syntax Doc Ann
forall ann. Doc ann
Pretty.rbrace
lparen :: Doc Ann
lparen   = Doc Ann -> Doc Ann
syntax Doc Ann
forall ann. Doc ann
Pretty.lparen
rparen :: Doc Ann
rparen   = Doc Ann -> Doc Ann
syntax Doc Ann
forall ann. Doc ann
Pretty.rparen
pipe :: Doc Ann
pipe     = Doc Ann -> Doc Ann
syntax Doc Ann
forall ann. Doc ann
Pretty.pipe
dollar :: Doc Ann
dollar   = Doc Ann -> Doc Ann
syntax Doc Ann
"$"
colon :: Doc Ann
colon    = Doc Ann -> Doc Ann
syntax Doc Ann
":"
equals :: Doc Ann
equals   = Doc Ann -> Doc Ann
syntax Doc Ann
"="
dot :: Doc Ann
dot      = Doc Ann -> Doc Ann
syntax Doc Ann
"."

lambda :: CharacterSet -> Doc Ann
lambda :: CharacterSet -> Doc Ann
lambda CharacterSet
Unicode = Doc Ann -> Doc Ann
syntax Doc Ann
"λ"
lambda CharacterSet
ASCII   = Doc Ann -> Doc Ann
syntax Doc Ann
"\\"

forall :: CharacterSet -> Doc Ann
forall :: CharacterSet -> Doc Ann
forall CharacterSet
Unicode = Doc Ann -> Doc Ann
syntax Doc Ann
"∀"
forall CharacterSet
ASCII   = Doc Ann -> Doc Ann
syntax Doc Ann
"forall "

rarrow :: CharacterSet -> Doc Ann
rarrow :: CharacterSet -> Doc Ann
rarrow CharacterSet
Unicode = Doc Ann -> Doc Ann
syntax Doc Ann
"→"
rarrow CharacterSet
ASCII   = Doc Ann -> Doc Ann
syntax Doc Ann
"->"

doubleColon :: Doc Ann
doubleColon :: Doc Ann
doubleColon = Doc Ann -> Doc Ann
syntax Doc Ann
"::"

-- | Pretty-print a list
list :: [Doc Ann] -> Doc Ann
list :: [Doc Ann] -> Doc Ann
list   [] = Doc Ann
lbracket Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
rbracket
list [Doc Ann]
docs =
    Doc Ann
-> Doc Ann
-> Doc Ann
-> Doc Ann
-> Doc Ann
-> Doc Ann
-> [(Doc Ann, Doc Ann)]
-> Doc Ann
forall ann.
Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> [(Doc ann, Doc ann)]
-> Doc ann
enclose
        (Doc Ann
lbracket Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
        (Doc Ann
lbracket Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
        (Doc Ann
comma Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
        (Doc Ann
comma Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
        (Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
rbracket)
        Doc Ann
rbracket
        ((Doc Ann -> (Doc Ann, Doc Ann))
-> [Doc Ann] -> [(Doc Ann, Doc Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Ann -> (Doc Ann, Doc Ann)
forall a. a -> (a, a)
duplicate [Doc Ann]
docs)

-- | Pretty-print union types and literals
angles :: [(Doc Ann, Doc Ann)] -> Doc Ann
angles :: [(Doc Ann, Doc Ann)] -> Doc Ann
angles   [] = Doc Ann
langle Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
rangle
angles [(Doc Ann, Doc Ann)]
docs =
    Doc Ann
-> Doc Ann
-> Doc Ann
-> Doc Ann
-> Doc Ann
-> Doc Ann
-> [(Doc Ann, Doc Ann)]
-> Doc Ann
forall ann.
Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> [(Doc ann, Doc ann)]
-> Doc ann
enclose
        (Doc Ann
langle Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
        (Doc Ann
langle Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
        (Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
pipe Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
        (Doc Ann
pipe Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
        (Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
rangle)
        Doc Ann
rangle
        [(Doc Ann, Doc Ann)]
docs

-- | Pretty-print record types and literals
braces :: [(Doc Ann, Doc Ann)] -> Doc Ann
braces :: [(Doc Ann, Doc Ann)] -> Doc Ann
braces   [] = Doc Ann
lbrace Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
rbrace
braces [(Doc Ann, Doc Ann)]
docs =
    Doc Ann
-> Doc Ann
-> Doc Ann
-> Doc Ann
-> Doc Ann
-> Doc Ann
-> [(Doc Ann, Doc Ann)]
-> Doc Ann
forall ann.
Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> [(Doc ann, Doc ann)]
-> Doc ann
enclose
        (Doc Ann
lbrace Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
        (Doc Ann
lbrace Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
        (Doc Ann
comma Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
        (Doc Ann
comma Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
        (Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
rbrace)
        Doc Ann
rbrace
        [(Doc Ann, Doc Ann)]
docs

hangingBraces :: Int -> [(Doc Ann, Doc Ann)] -> Doc Ann
hangingBraces :: Int -> [(Doc Ann, Doc Ann)] -> Doc Ann
hangingBraces Int
_ [] =
    Doc Ann
lbrace Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
rbrace
hangingBraces Int
n [(Doc Ann, Doc Ann)]
docs =
    Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group
        (Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt
            (  Doc Ann
lbrace
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
Pretty.hardline
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Ann -> Doc Ann
forall ann. Int -> Doc ann -> Doc ann
Pretty.indent Int
n
               ( [Doc Ann] -> Doc Ann
forall a. Monoid a => [a] -> a
mconcat ((Doc Ann -> Doc Ann -> Doc Ann)
-> [Doc Ann] -> [Doc Ann] -> [Doc Ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
combineLong (Doc Ann -> [Doc Ann]
forall a. a -> [a]
repeat Doc Ann
separator) [Doc Ann]
docsLong)
               Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
rbrace
               )
            )
            ([Doc Ann] -> Doc Ann
forall a. Monoid a => [a] -> a
mconcat ((Doc Ann -> Doc Ann -> Doc Ann)
-> [Doc Ann] -> [Doc Ann] -> [Doc Ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
(<>) (Doc Ann
beginShort Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Doc Ann -> [Doc Ann]
forall a. a -> [a]
repeat Doc Ann
separator) [Doc Ann]
docsShort) Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
rbrace)
        )
  where
    separator :: Doc Ann
separator = Doc Ann
comma Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space

    docsShort :: [Doc Ann]
docsShort = ((Doc Ann, Doc Ann) -> Doc Ann)
-> [(Doc Ann, Doc Ann)] -> [Doc Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc Ann, Doc Ann) -> Doc Ann
forall a b. (a, b) -> a
fst [(Doc Ann, Doc Ann)]
docs

    docsLong :: [Doc Ann]
docsLong = ((Doc Ann, Doc Ann) -> Doc Ann)
-> [(Doc Ann, Doc Ann)] -> [Doc Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc Ann, Doc Ann) -> Doc Ann
forall a b. (a, b) -> b
snd [(Doc Ann, Doc Ann)]
docs

    beginShort :: Doc Ann
beginShort = Doc Ann
lbrace Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space

    combineLong :: Doc ann -> Doc ann -> Doc ann
combineLong Doc ann
x Doc ann
y = Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
y Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
Pretty.hardline

unsnoc :: [a] -> Maybe ([a], a)
unsnoc :: [a] -> Maybe ([a], a)
unsnoc       []   = Maybe ([a], a)
forall a. Maybe a
Nothing
unsnoc (a
x0 : [a]
xs0) = ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just (([a] -> [a]) -> a -> [a] -> ([a], a)
forall t c. ([t] -> c) -> t -> [t] -> (c, t)
go [a] -> [a]
forall a. a -> a
id a
x0 [a]
xs0)
  where
    go :: ([t] -> c) -> t -> [t] -> (c, t)
go [t] -> c
diffXs t
x      []  = ([t] -> c
diffXs [], t
x)
    go [t] -> c
diffXs t
x (t
y : [t]
ys) = ([t] -> c) -> t -> [t] -> (c, t)
go ([t] -> c
diffXs ([t] -> c) -> ([t] -> [t]) -> [t] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t
xt -> [t] -> [t]
forall a. a -> [a] -> [a]
:)) t
y [t]
ys

-- | Pretty-print anonymous functions and function types
arrows :: CharacterSet -> [ Doc Ann ] -> Doc Ann
arrows :: CharacterSet -> [Doc Ann] -> Doc Ann
arrows CharacterSet
characterSet [Doc Ann]
docs = Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short)
  where
    long :: Doc Ann
long = Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align ([Doc Ann] -> Doc Ann
forall a. Monoid a => [a] -> a
mconcat (Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
Data.List.intersperse Doc Ann
forall ann. Doc ann
Pretty.hardline [Doc Ann]
docs'))
      where
        docs' :: [Doc Ann]
docs' = case [Doc Ann] -> Maybe ([Doc Ann], Doc Ann)
forall a. [a] -> Maybe ([a], a)
unsnoc [Doc Ann]
docs of
            Maybe ([Doc Ann], Doc Ann)
Nothing -> [Doc Ann]
docs

            Just ([Doc Ann]
init_, Doc Ann
last_) -> [Doc Ann]
init' [Doc Ann] -> [Doc Ann] -> [Doc Ann]
forall a. [a] -> [a] -> [a]
++ [ Doc Ann
last' ]
              where
                 appendArrow :: Doc Ann -> Doc Ann
appendArrow Doc Ann
doc = Doc Ann
doc Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> CharacterSet -> Doc Ann
rarrow CharacterSet
characterSet

                 init' :: [Doc Ann]
init' = (Doc Ann -> Doc Ann) -> [Doc Ann] -> [Doc Ann]
forall a b. (a -> b) -> [a] -> [b]
map Doc Ann -> Doc Ann
appendArrow [Doc Ann]
init_

                 last' :: Doc Ann
last' = Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
last_

    short :: Doc Ann
short = [Doc Ann] -> Doc Ann
forall a. Monoid a => [a] -> a
mconcat (Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
Data.List.intersperse Doc Ann
separator [Doc Ann]
docs)
      where
        separator :: Doc Ann
separator = Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> CharacterSet -> Doc Ann
rarrow CharacterSet
characterSet Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space

combine :: CharacterSet -> Text
combine :: CharacterSet -> Text
combine CharacterSet
ASCII   = Text
"/\\"
combine CharacterSet
Unicode = Text
"∧"

combineTypes :: CharacterSet -> Text
combineTypes :: CharacterSet -> Text
combineTypes CharacterSet
ASCII   = Text
"//\\\\"
combineTypes CharacterSet
Unicode = Text
"⩓"

prefer :: CharacterSet -> Text
prefer :: CharacterSet -> Text
prefer CharacterSet
ASCII   = Text
"//"
prefer CharacterSet
Unicode = Text
"⫽"

equivalent :: CharacterSet -> Text
equivalent :: CharacterSet -> Text
equivalent CharacterSet
ASCII   = Text
"==="
equivalent CharacterSet
Unicode = Text
"≡"

{-| Format an expression that holds a variable number of elements, such as a
    list, record, or union
-}
enclose
    :: Doc ann
    -- ^ Beginning document for compact representation
    -> Doc ann
    -- ^ Beginning document for multi-line representation
    -> Doc ann
    -- ^ Separator for compact representation
    -> Doc ann
    -- ^ Separator for multi-line representation
    -> Doc ann
    -- ^ Ending document for compact representation
    -> Doc ann
    -- ^ Ending document for multi-line representation
    -> [(Doc ann, Doc ann)]
    -- ^ Elements to format, each of which is a pair: @(compact, multi-line)@
    -> Doc ann
enclose :: Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> [(Doc ann, Doc ann)]
-> Doc ann
enclose Doc ann
beginShort Doc ann
_         Doc ann
_        Doc ann
_       Doc ann
endShort Doc ann
_       []   =
    Doc ann
beginShort Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
endShort
  where
enclose Doc ann
beginShort Doc ann
beginLong Doc ann
sepShort Doc ann
sepLong Doc ann
endShort Doc ann
endLong [(Doc ann, Doc ann)]
docs =
    Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
Pretty.group
        (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt
            (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
Pretty.align
                ([Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ((Doc ann -> Doc ann -> Doc ann)
-> [Doc ann] -> [Doc ann] -> [Doc ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
combineLong (Doc ann
beginLong Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: Doc ann -> [Doc ann]
forall a. a -> [a]
repeat Doc ann
sepLong) [Doc ann]
docsLong) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
endLong)
            )
            ([Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ((Doc ann -> Doc ann -> Doc ann)
-> [Doc ann] -> [Doc ann] -> [Doc ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
combineShort (Doc ann
beginShort Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: Doc ann -> [Doc ann]
forall a. a -> [a]
repeat Doc ann
sepShort) [Doc ann]
docsShort) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
endShort)
        )
  where
    docsShort :: [Doc ann]
docsShort = ((Doc ann, Doc ann) -> Doc ann)
-> [(Doc ann, Doc ann)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc ann, Doc ann) -> Doc ann
forall a b. (a, b) -> a
fst [(Doc ann, Doc ann)]
docs

    docsLong :: [Doc ann]
docsLong = ((Doc ann, Doc ann) -> Doc ann)
-> [(Doc ann, Doc ann)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc ann, Doc ann) -> Doc ann
forall a b. (a, b) -> b
snd [(Doc ann, Doc ann)]
docs

    combineLong :: Doc ann -> Doc ann -> Doc ann
combineLong Doc ann
x Doc ann
y = Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
y Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
Pretty.hardline

    combineShort :: a -> a -> a
combineShort a
x a
y = a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y

{-| Format an expression that holds a variable number of elements without a
    trailing document such as nested `let`, nested lambdas, or nested `forall`s
-}
enclose'
    :: Doc ann
    -- ^ Beginning document for compact representation
    -> Doc ann
    -- ^ Beginning document for multi-line representation
    -> Doc ann
    -- ^ Separator for compact representation
    -> Doc ann
    -- ^ Separator for multi-line representation
    -> [(Doc ann, Doc ann)]
    -- ^ Elements to format, each of which is a pair: @(compact, multi-line)@
    -> Doc ann
enclose' :: Doc ann
-> Doc ann -> Doc ann -> Doc ann -> [(Doc ann, Doc ann)] -> Doc ann
enclose' Doc ann
beginShort Doc ann
beginLong Doc ann
sepShort Doc ann
sepLong [(Doc ann, Doc ann)]
docs =
    Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc ann
long Doc ann
short)
  where
    longLines :: [Doc ann]
longLines = (Doc ann -> Doc ann -> Doc ann)
-> [Doc ann] -> [Doc ann] -> [Doc ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
(<>) (Doc ann
beginLong Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: Doc ann -> [Doc ann]
forall a. a -> [a]
repeat Doc ann
sepLong) [Doc ann]
docsLong

    long :: Doc ann
long =
        Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
Pretty.align ([Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat (Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
Data.List.intersperse Doc ann
forall ann. Doc ann
Pretty.hardline [Doc ann]
longLines))

    short :: Doc ann
short = [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ((Doc ann -> Doc ann -> Doc ann)
-> [Doc ann] -> [Doc ann] -> [Doc ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
(<>) (Doc ann
beginShort Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: Doc ann -> [Doc ann]
forall a. a -> [a]
repeat Doc ann
sepShort) [Doc ann]
docsShort)

    docsShort :: [Doc ann]
docsShort = ((Doc ann, Doc ann) -> Doc ann)
-> [(Doc ann, Doc ann)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc ann, Doc ann) -> Doc ann
forall a b. (a, b) -> a
fst [(Doc ann, Doc ann)]
docs

    docsLong :: [Doc ann]
docsLong = ((Doc ann, Doc ann) -> Doc ann)
-> [(Doc ann, Doc ann)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc ann, Doc ann) -> Doc ann
forall a b. (a, b) -> b
snd [(Doc ann, Doc ann)]
docs

alpha :: Char -> Bool
alpha :: Char -> Bool
alpha Char
c = (Char
'\x41' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x5A') Bool -> Bool -> Bool
|| (Char
'\x61' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x7A')

digit :: Char -> Bool
digit :: Char -> Bool
digit Char
c = Char
'\x30' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x39'

alphaNum :: Char -> Bool
alphaNum :: Char -> Bool
alphaNum Char
c = Char -> Bool
alpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
digit Char
c

headCharacter :: Char -> Bool
headCharacter :: Char -> Bool
headCharacter Char
c = Char -> Bool
alpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

tailCharacter :: Char -> Bool
tailCharacter :: Char -> Bool
tailCharacter Char
c = Char -> Bool
alphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'

-- | Escape a label if it is not valid when unquoted
escapeLabel :: Bool -> Text -> Text
escapeLabel :: Bool -> Text -> Text
escapeLabel Bool
allowReserved Text
l =
    case Text -> Maybe (Char, Text)
Text.uncons Text
l of
        Just (Char
h, Text
t)
            | Char -> Bool
headCharacter Char
h Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
tailCharacter Text
t Bool -> Bool -> Bool
&& (Bool
notReservedIdentifier Bool -> Bool -> Bool
|| (Bool
allowReserved Bool -> Bool -> Bool
&& Bool
someOrNotLanguageKeyword))
                -> Text
l
        Maybe (Char, Text)
_       -> Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
    where
        notReservedIdentifier :: Bool
notReservedIdentifier = Bool -> Bool
not (Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
Data.HashSet.member Text
l HashSet Text
reservedIdentifiers)
        someOrNotLanguageKeyword :: Bool
someOrNotLanguageKeyword = Text
l Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Some" Bool -> Bool -> Bool
|| Bool -> Bool
not (Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
Data.HashSet.member Text
l HashSet Text
reservedKeywords)

prettyLabelShared :: Bool -> Text -> Doc Ann
prettyLabelShared :: Bool -> Text -> Doc Ann
prettyLabelShared Bool
b Text
l = Doc Ann -> Doc Ann
label (Text -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (Bool -> Text -> Text
escapeLabel Bool
b Text
l))

prettyLabel :: Text -> Doc Ann
prettyLabel :: Text -> Doc Ann
prettyLabel = Bool -> Text -> Doc Ann
prettyLabelShared Bool
False

prettyAnyLabel :: Text -> Doc Ann
prettyAnyLabel :: Text -> Doc Ann
prettyAnyLabel = Bool -> Text -> Doc Ann
prettyLabelShared Bool
True

prettyAnyLabels :: Foldable list => list Text -> Doc Ann
prettyAnyLabels :: list Text -> Doc Ann
prettyAnyLabels =
    [Doc Ann] -> Doc Ann
forall a. Monoid a => [a] -> a
mconcat ([Doc Ann] -> Doc Ann)
-> (list Text -> [Doc Ann]) -> list Text -> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Ann -> [Doc Ann] -> [Doc Ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
Pretty.punctuate Doc Ann
dot ([Doc Ann] -> [Doc Ann])
-> (list Text -> [Doc Ann]) -> list Text -> [Doc Ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc Ann) -> [Text] -> [Doc Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Doc Ann
prettyAnyLabel ([Text] -> [Doc Ann])
-> (list Text -> [Text]) -> list Text -> [Doc Ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. list Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

prettyLabels :: Set Text -> Doc Ann
prettyLabels :: Set Text -> Doc Ann
prettyLabels Set Text
a
    | Set Text -> Bool
forall a. Set a -> Bool
Data.Set.null (Set Text -> Set Text
forall a. Set a -> Set a
Dhall.Set.toSet Set Text
a) =
        Doc Ann
lbrace Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
rbrace
    | Bool
otherwise =
        [(Doc Ann, Doc Ann)] -> Doc Ann
braces ((Text -> (Doc Ann, Doc Ann)) -> [Text] -> [(Doc Ann, Doc Ann)]
forall a b. (a -> b) -> [a] -> [b]
map (Doc Ann -> (Doc Ann, Doc Ann)
forall a. a -> (a, a)
duplicate (Doc Ann -> (Doc Ann, Doc Ann))
-> (Text -> Doc Ann) -> Text -> (Doc Ann, Doc Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Ann
prettyAnyLabel) (Set Text -> [Text]
forall a. Set a -> [a]
Dhall.Set.toList Set Text
a))

prettyNumber :: Integer -> Doc Ann
prettyNumber :: Integer -> Doc Ann
prettyNumber = Doc Ann -> Doc Ann
literal (Doc Ann -> Doc Ann) -> (Integer -> Doc Ann) -> Integer -> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty

prettyInt :: Int -> Doc Ann
prettyInt :: Int -> Doc Ann
prettyInt = Doc Ann -> Doc Ann
literal (Doc Ann -> Doc Ann) -> (Int -> Doc Ann) -> Int -> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty

prettyNatural :: Natural -> Doc Ann
prettyNatural :: Natural -> Doc Ann
prettyNatural = Doc Ann -> Doc Ann
literal (Doc Ann -> Doc Ann) -> (Natural -> Doc Ann) -> Natural -> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty

prettyDouble :: Double -> Doc Ann
prettyDouble :: Double -> Doc Ann
prettyDouble = Doc Ann -> Doc Ann
literal (Doc Ann -> Doc Ann) -> (Double -> Doc Ann) -> Double -> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty

prettyConst :: Const -> Doc Ann
prettyConst :: Const -> Doc Ann
prettyConst Const
Type = Doc Ann -> Doc Ann
builtin Doc Ann
"Type"
prettyConst Const
Kind = Doc Ann -> Doc Ann
builtin Doc Ann
"Kind"
prettyConst Const
Sort = Doc Ann -> Doc Ann
builtin Doc Ann
"Sort"

prettyVar :: Var -> Doc Ann
prettyVar :: Var -> Doc Ann
prettyVar (V Text
x Int
0) = Doc Ann -> Doc Ann
label (Doc Ann -> Doc Ann
forall ann xxx. Doc ann -> Doc xxx
Pretty.unAnnotate (Text -> Doc Ann
prettyLabel Text
x))
prettyVar (V Text
x Int
n) = Doc Ann -> Doc Ann
label (Doc Ann -> Doc Ann
forall ann xxx. Doc ann -> Doc xxx
Pretty.unAnnotate (Text -> Doc Ann
prettyLabel Text
x Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"@" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Ann
prettyInt Int
n))

prettyEnvironmentVariable :: Text -> Doc ann
prettyEnvironmentVariable :: Text -> Doc ann
prettyEnvironmentVariable Text
t = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (Text -> Text
escapeEnvironmentVariable Text
t)

preserveSource :: Expr Src a -> Maybe (Doc Ann)
preserveSource :: Expr Src a -> Maybe (Doc Ann)
preserveSource (Note Src{Text
SourcePos
srcText :: Text
srcEnd :: SourcePos
srcStart :: SourcePos
srcText :: Src -> Text
srcEnd :: Src -> SourcePos
srcStart :: Src -> SourcePos
..} (DoubleLit  {})) = Doc Ann -> Maybe (Doc Ann)
forall a. a -> Maybe a
Just (Text -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
srcText)
preserveSource (Note Src{Text
SourcePos
srcText :: Text
srcEnd :: SourcePos
srcStart :: SourcePos
srcText :: Src -> Text
srcEnd :: Src -> SourcePos
srcStart :: Src -> SourcePos
..} (IntegerLit {})) = Doc Ann -> Maybe (Doc Ann)
forall a. a -> Maybe a
Just (Text -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
srcText)
preserveSource (Note Src{Text
SourcePos
srcText :: Text
srcEnd :: SourcePos
srcStart :: SourcePos
srcText :: Src -> Text
srcEnd :: Src -> SourcePos
srcStart :: Src -> SourcePos
..} (NaturalLit {})) = Doc Ann -> Maybe (Doc Ann)
forall a. a -> Maybe a
Just (Text -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
srcText)
preserveSource  Expr Src a
_                             = Maybe (Doc Ann)
forall a. Maybe a
Nothing

-- | Escape an environment variable if not a valid Bash environment variable
escapeEnvironmentVariable :: Text -> Text
escapeEnvironmentVariable :: Text -> Text
escapeEnvironmentVariable Text
t
  | Text -> Bool
validBashEnvVar Text
t = Text
t
  | Bool
otherwise         = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeText_ Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  where
    validBashEnvVar :: Text -> Bool
validBashEnvVar Text
v = case Text -> Maybe (Char, Text)
Text.uncons Text
v of
        Maybe (Char, Text)
Nothing      -> Bool
False
        Just (Char
c, Text
v') ->
                (Char -> Bool
alpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
            Bool -> Bool -> Bool
&&  (Char -> Bool) -> Text -> Bool
Text.all (\Char
c' -> Char -> Bool
alphaNum Char
c' Bool -> Bool -> Bool
|| Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Text
v'

{-  There is a close correspondence between the pretty-printers in 'prettyCharacterSet'
    and the sub-parsers in 'Dhall.Parser.Expression.parsers'.  Most pretty-printers are
    named after the corresponding parser and the relationship between pretty-printers
    exactly matches the relationship between parsers.  This leads to the nice emergent
    property of automatically getting all the parentheses and precedences right.

    This approach has one major disadvantage: you can get an infinite loop if
    you add a new constructor to the syntax tree without adding a matching
    case the corresponding builder.
-}

{-| Pretty-print an 'Expr' using the given 'CharacterSet'.

'prettyCharacterSet' largely ignores 'Note's. 'Note's do however matter for
the layout of let-blocks:

>>> let inner = Let (Binding Nothing "x" Nothing Nothing Nothing (NaturalLit 1)) (Var (V "x" 0)) :: Expr Src ()
>>> prettyCharacterSet ASCII (Let (Binding Nothing "y" Nothing Nothing Nothing (NaturalLit 2)) inner)
let y = 2 let x = 1 in x
>>> prettyCharacterSet ASCII (Let (Binding Nothing "y" Nothing Nothing Nothing (NaturalLit 2)) (Note (Src unusedSourcePos unusedSourcePos "") inner))
let y = 2 in let x = 1 in x

This means the structure of parsed let-blocks is preserved.
-}
prettyCharacterSet :: Pretty a => CharacterSet -> Expr Src a -> Doc Ann
prettyCharacterSet :: CharacterSet -> Expr Src a -> Doc Ann
prettyCharacterSet CharacterSet
characterSet Expr Src a
expression =
    Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Expr Src a
expression)
  where
    prettyExpression :: Expr Src a -> Doc Ann
prettyExpression a0 :: Expr Src a
a0@(Lam Text
_ Expr Src a
_ Expr Src a
_) =
        CharacterSet -> [Doc Ann] -> Doc Ann
arrows CharacterSet
characterSet (Expr Src a -> [Doc Ann]
docs Expr Src a
a0)
      where
        docs :: Expr Src a -> [Doc Ann]
docs (Lam Text
a Expr Src a
b Expr Src a
c) = Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short) Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
c
          where
            long :: Doc Ann
long =  (CharacterSet -> Doc Ann
lambda CharacterSet
characterSet Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
                    (   (Doc Ann
lparen Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Text -> Doc Ann
prettyLabel Text
a
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
Pretty.hardline
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  (Doc Ann
colon Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyExpression Expr Src a
b
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
Pretty.hardline
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
rparen
                    )

            short :: Doc Ann
short = (CharacterSet -> Doc Ann
lambda CharacterSet
characterSet Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
lparen)
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Text -> Doc Ann
prettyLabel Text
a
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  (Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
colon Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyExpression Expr Src a
b
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
rparen
        docs Expr Src a
c
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
c =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
d <- Expr Src a
c =
                Expr Src a -> [Doc Ann]
docs Expr Src a
d
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
prettyExpression Expr Src a
c ]
    prettyExpression a0 :: Expr Src a
a0@(BoolIf Expr Src a
_ Expr Src a
_ Expr Src a
_) =
        Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short)
      where
        prefixesLong :: [Doc Ann]
prefixesLong =
                Doc Ann
""
            Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
:   [Doc Ann] -> [Doc Ann]
forall a. [a] -> [a]
cycle
                    [ Doc Ann -> Doc Ann
keyword Doc Ann
"then" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"  "
                    , Doc Ann -> Doc Ann
keyword Doc Ann
"else" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"  "
                    ]

        prefixesShort :: [Doc Ann]
prefixesShort =
                Doc Ann
""
            Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
:   [Doc Ann] -> [Doc Ann]
forall a. [a] -> [a]
cycle
                    [ Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> Doc Ann
keyword Doc Ann
"then" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space
                    , Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> Doc Ann
keyword Doc Ann
"else" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space
                    ]

        longLines :: [Doc Ann]
longLines = (Doc Ann -> Doc Ann -> Doc Ann)
-> [Doc Ann] -> [Doc Ann] -> [Doc Ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
(<>) [Doc Ann]
prefixesLong (Bool -> Expr Src a -> [Doc Ann]
docsLong Bool
True Expr Src a
a0)

        long :: Doc Ann
long =
            Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align ([Doc Ann] -> Doc Ann
forall a. Monoid a => [a] -> a
mconcat (Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
Data.List.intersperse Doc Ann
forall ann. Doc ann
Pretty.hardline [Doc Ann]
longLines))

        short :: Doc Ann
short = [Doc Ann] -> Doc Ann
forall a. Monoid a => [a] -> a
mconcat ((Doc Ann -> Doc Ann -> Doc Ann)
-> [Doc Ann] -> [Doc Ann] -> [Doc Ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
(<>) [Doc Ann]
prefixesShort (Expr Src a -> [Doc Ann]
docsShort Expr Src a
a0))

        docsLong :: Bool -> Expr Src a -> [Doc Ann]
docsLong Bool
initial (BoolIf Expr Src a
a Expr Src a
b Expr Src a
c) =
            [Doc Ann]
docLong [Doc Ann] -> [Doc Ann] -> [Doc Ann]
forall a. [a] -> [a] -> [a]
++ Bool -> Expr Src a -> [Doc Ann]
docsLong Bool
False Expr Src a
c
          where
            padding :: Doc Ann
padding
                | Bool
initial   = Doc Ann
"   "
                | Bool
otherwise = Doc Ann
forall a. Monoid a => a
mempty

            docLong :: [Doc Ann]
docLong =
                [   Doc Ann -> Doc Ann
keyword Doc Ann
"if" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
padding Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr Src a -> Doc Ann
prettyExpression Expr Src a
a
                ,   Expr Src a -> Doc Ann
prettyExpression Expr Src a
b
                ]
        docsLong Bool
initial Expr Src a
c
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
c =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
d <- Expr Src a
c =
                Bool -> Expr Src a -> [Doc Ann]
docsLong Bool
initial Expr Src a
d
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
prettyExpression Expr Src a
c ]

        docsShort :: Expr Src a -> [Doc Ann]
docsShort (BoolIf Expr Src a
a Expr Src a
b Expr Src a
c) =
            [Doc Ann]
docShort [Doc Ann] -> [Doc Ann] -> [Doc Ann]
forall a. [a] -> [a] -> [a]
++ Expr Src a -> [Doc Ann]
docsShort Expr Src a
c
          where
            docShort :: [Doc Ann]
docShort =
                [   Doc Ann -> Doc Ann
keyword Doc Ann
"if" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr Src a -> Doc Ann
prettyExpression Expr Src a
a
                ,   Expr Src a -> Doc Ann
prettyExpression Expr Src a
b
                ]
        docsShort Expr Src a
c
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
c =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
d <- Expr Src a
c =
                Expr Src a -> [Doc Ann]
docsShort Expr Src a
d
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
prettyExpression Expr Src a
c ]
    prettyExpression (Let Binding Src a
a0 Expr Src a
b0) =
        Doc Ann
-> Doc Ann -> Doc Ann -> Doc Ann -> [(Doc Ann, Doc Ann)] -> Doc Ann
forall ann.
Doc ann
-> Doc ann -> Doc ann -> Doc ann -> [(Doc ann, Doc ann)] -> Doc ann
enclose' Doc Ann
"" Doc Ann
"" Doc Ann
forall ann. Doc ann
space Doc Ann
forall ann. Doc ann
Pretty.hardline
            ((Doc Ann -> (Doc Ann, Doc Ann))
-> [Doc Ann] -> [(Doc Ann, Doc Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Ann -> (Doc Ann, Doc Ann)
forall a. a -> (a, a)
duplicate ((Binding Src a -> Doc Ann) -> [Binding Src a] -> [Doc Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Binding Src a -> Doc Ann
docA (NonEmpty (Binding Src a) -> [Binding Src a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Binding Src a)
as)) [(Doc Ann, Doc Ann)]
-> [(Doc Ann, Doc Ann)] -> [(Doc Ann, Doc Ann)]
forall a. [a] -> [a] -> [a]
++ [ (Doc Ann, Doc Ann)
docB ])
      where
        MultiLet NonEmpty (Binding Src a)
as Expr Src a
b = Binding Src a -> Expr Src a -> MultiLet Src a
forall s a. Binding s a -> Expr s a -> MultiLet s a
multiLet Binding Src a
a0 Expr Src a
b0

        stripSpaces :: Text -> Text
stripSpaces = (Char -> Bool) -> Text -> Text
Text.dropAround (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')

        -- Strip a single newline character. Needed to ensure idempotency in
        -- cases where we add hard line breaks.
        stripNewline :: Text -> Text
stripNewline Text
t =
            case Text -> Maybe (Char, Text)
Text.uncons Text
t' of
                Just (Char
'\n', Text
t'') -> Text -> Text
stripSpaces Text
t''
                Maybe (Char, Text)
_ -> Text
t'
          where t' :: Text
t' = Text -> Text
stripSpaces Text
t

        docA :: Binding Src a -> Doc Ann
docA (Binding Maybe Src
src0 Text
c Maybe Src
src1 Maybe (Maybe Src, Expr Src a)
Nothing Maybe Src
src2 Expr Src a
e) =
            Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short)
          where
            long :: Doc Ann
long =  Doc Ann -> Doc Ann
keyword Doc Ann
"let" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
                    (   (Text -> Text) -> Maybe Src -> Doc Ann
renderSrc Text -> Text
stripSpaces Maybe Src
src0
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Text -> Doc Ann
prettyLabel Text
c Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Maybe Src -> Doc Ann
renderSrc Text -> Text
stripSpaces Maybe Src
src1
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
equals Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
Pretty.hardline Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Maybe Src -> Doc Ann
renderSrc Text -> Text
stripNewline Maybe Src
src2
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"  " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr Src a -> Doc Ann
prettyExpression Expr Src a
e
                    )

            short :: Doc Ann
short = Doc Ann -> Doc Ann
keyword Doc Ann
"let" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Maybe Src -> Doc Ann
renderSrc Text -> Text
stripSpaces Maybe Src
src0
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Text -> Doc Ann
prettyLabel Text
c Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Maybe Src -> Doc Ann
renderSrc Text -> Text
stripSpaces Maybe Src
src1
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
equals Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Maybe Src -> Doc Ann
renderSrc Text -> Text
stripSpaces Maybe Src
src2
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyExpression Expr Src a
e
        docA (Binding Maybe Src
src0 Text
c Maybe Src
src1 (Just (Maybe Src
src3, Expr Src a
d)) Maybe Src
src2 Expr Src a
e) =
                Doc Ann -> Doc Ann
keyword Doc Ann
"let" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
                (   (Text -> Text) -> Maybe Src -> Doc Ann
renderSrc Text -> Text
stripSpaces Maybe Src
src0
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Text -> Doc Ann
prettyLabel Text
c Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
Pretty.hardline Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Maybe Src -> Doc Ann
renderSrc Text -> Text
stripNewline Maybe Src
src1
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
colon Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Maybe Src -> Doc Ann
renderSrc Text -> Text
stripSpaces Maybe Src
src3 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr Src a -> Doc Ann
prettyExpression Expr Src a
d Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
Pretty.hardline
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
equals Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Maybe Src -> Doc Ann
renderSrc Text -> Text
stripSpaces Maybe Src
src2
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyExpression Expr Src a
e
                )

        docB :: (Doc Ann, Doc Ann)
docB =
            ( Doc Ann -> Doc Ann
keyword Doc Ann
"in" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr Src a -> Doc Ann
prettyExpression Expr Src a
b
            , Doc Ann -> Doc Ann
keyword Doc Ann
"in" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"  "  Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr Src a -> Doc Ann
prettyExpression Expr Src a
b
            )
    prettyExpression a0 :: Expr Src a
a0@(Pi Text
_ Expr Src a
_ Expr Src a
_) =
        CharacterSet -> [Doc Ann] -> Doc Ann
arrows CharacterSet
characterSet (Expr Src a -> [Doc Ann]
docs Expr Src a
a0)
      where
        docs :: Expr Src a -> [Doc Ann]
docs (Pi Text
"_" Expr Src a
b Expr Src a
c) = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyOperatorExpression Expr Src a
b Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
c
        docs (Pi Text
a   Expr Src a
b Expr Src a
c) = Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short) Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
c
          where
            long :: Doc Ann
long =  CharacterSet -> Doc Ann
forall CharacterSet
characterSet Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
                    (   Doc Ann
lparen Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Text -> Doc Ann
prettyLabel Text
a
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
Pretty.hardline
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
colon Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyExpression Expr Src a
b
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
Pretty.hardline
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
rparen
                    )

            short :: Doc Ann
short = CharacterSet -> Doc Ann
forall CharacterSet
characterSet Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
lparen
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Text -> Doc Ann
prettyLabel Text
a
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
colon Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyExpression Expr Src a
b
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
rparen
        docs Expr Src a
c
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
c =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
d <- Expr Src a
c =
                Expr Src a -> [Doc Ann]
docs Expr Src a
d
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
prettyExpression Expr Src a
c ]
    prettyExpression (With Expr Src a
a NonEmpty Text
b Expr Src a
c) =
            Expr Src a -> Doc Ann
prettyExpression Expr Src a
a
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short
      where
        short :: Doc Ann
short = Doc Ann
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> Doc Ann
keyword Doc Ann
"with" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
update

        long :: Doc Ann
long =  Doc Ann
forall ann. Doc ann
Pretty.hardline
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"  "
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align (Doc Ann -> Doc Ann
keyword Doc Ann
"with" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
update)

        (Doc Ann
update, Doc Ann
_) =
            (NonEmpty Text -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> (NonEmpty Text, Expr Src a)
-> (Doc Ann, Doc Ann)
forall a k.
Pretty a =>
(k -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> (k, Expr Src a)
-> (Doc Ann, Doc Ann)
prettyKeyValue NonEmpty Text -> Doc Ann
forall (list :: * -> *). Foldable list => list Text -> Doc Ann
prettyAnyLabels Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyOperatorExpression Doc Ann
equals (NonEmpty Text
b, Expr Src a
c)
    prettyExpression (Assert Expr Src a
a) =
        Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short)
      where
        short :: Doc Ann
short = Doc Ann -> Doc Ann
keyword Doc Ann
"assert" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
colon Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr Src a -> Doc Ann
prettyExpression Expr Src a
a

        long :: Doc Ann
long =
            Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
            (  Doc Ann
"  " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> Doc Ann
keyword Doc Ann
"assert"
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
Pretty.hardline Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
colon Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr Src a -> Doc Ann
prettyExpression Expr Src a
a
            )
    prettyExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
prettyExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyAnnotatedExpression Expr Src a
a

    prettyAnnotatedExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyAnnotatedExpression :: Expr Src a -> Doc Ann
prettyAnnotatedExpression (Merge Expr Src a
a Expr Src a
b (Just Expr Src a
c)) =
        Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short)
      where
        long :: Doc Ann
long =
            Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
                (   Doc Ann -> Doc Ann
keyword Doc Ann
"merge"
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
Pretty.hardline
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Int -> Doc Ann -> Doc Ann
forall ann. Int -> Doc ann -> Doc ann
Pretty.indent Int
2 (Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression Expr Src a
a)
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
Pretty.hardline
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Int -> Doc Ann -> Doc Ann
forall ann. Int -> Doc ann -> Doc ann
Pretty.indent Int
2 (Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression Expr Src a
b)
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
Pretty.hardline
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
colon Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyApplicationExpression Expr Src a
c
                )

        short :: Doc Ann
short = Doc Ann -> Doc Ann
keyword Doc Ann
"merge" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression Expr Src a
a
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
" "
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression Expr Src a
b
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
colon Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyApplicationExpression Expr Src a
c
    prettyAnnotatedExpression (ToMap Expr Src a
a (Just Expr Src a
b)) =
        Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short)
      where
        long :: Doc Ann
long =
            Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
                (   Doc Ann -> Doc Ann
keyword Doc Ann
"toMap"
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
Pretty.hardline
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Int -> Doc Ann -> Doc Ann
forall ann. Int -> Doc ann -> Doc ann
Pretty.indent Int
2 (Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression Expr Src a
a)
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
Pretty.hardline
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
colon Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyApplicationExpression Expr Src a
b
                )

        short :: Doc Ann
short = Doc Ann -> Doc Ann
keyword Doc Ann
"toMap" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression Expr Src a
a
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
colon Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyApplicationExpression Expr Src a
b
    prettyAnnotatedExpression a0 :: Expr Src a
a0@(Annot Expr Src a
_ Expr Src a
_) =
        Doc Ann
-> Doc Ann -> Doc Ann -> Doc Ann -> [(Doc Ann, Doc Ann)] -> Doc Ann
forall ann.
Doc ann
-> Doc ann -> Doc ann -> Doc ann -> [(Doc ann, Doc ann)] -> Doc ann
enclose'
            Doc Ann
""
            Doc Ann
"  "
            (Doc Ann
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
colon Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" ")
            (Doc Ann
colon Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
            ((Doc Ann -> (Doc Ann, Doc Ann))
-> [Doc Ann] -> [(Doc Ann, Doc Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Ann -> (Doc Ann, Doc Ann)
forall a. a -> (a, a)
duplicate (Expr Src a -> [Doc Ann]
forall a. Pretty a => Expr Src a -> [Doc Ann]
docs Expr Src a
a0))
      where
        docs :: Expr Src a -> [Doc Ann]
docs (Annot Expr Src a
a Expr Src a
b) = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyOperatorExpression Expr Src a
a Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
b
        docs Expr Src a
a
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
b <- Expr Src a
a =
                Expr Src a -> [Doc Ann]
docs Expr Src a
b
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Expr Src a
a ]
    prettyAnnotatedExpression (ListLit (Just Expr Src a
a) Seq (Expr Src a)
b) =
            [Doc Ann] -> Doc Ann
list ((Expr Src a -> Doc Ann) -> [Expr Src a] -> [Doc Ann]
forall a b. (a -> b) -> [a] -> [b]
map Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression (Seq (Expr Src a) -> [Expr Src a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Seq (Expr Src a)
b))
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
" : "
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyApplicationExpression Expr Src a
a
    prettyAnnotatedExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyAnnotatedExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyOperatorExpression Expr Src a
a

    prettyOperatorExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyOperatorExpression :: Expr Src a -> Doc Ann
prettyOperatorExpression = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyEquivalentExpression

    prettyOperator :: Text -> [Doc Ann] -> Doc Ann
    prettyOperator :: Text -> [Doc Ann] -> Doc Ann
prettyOperator Text
op [Doc Ann]
docs =
        Doc Ann
-> Doc Ann -> Doc Ann -> Doc Ann -> [(Doc Ann, Doc Ann)] -> Doc Ann
forall ann.
Doc ann
-> Doc ann -> Doc ann -> Doc ann -> [(Doc ann, Doc ann)] -> Doc ann
enclose'
            Doc Ann
""
            Doc Ann
prefix
            (Doc Ann
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> Doc Ann
operator (Text -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
op) Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" ")
            (Doc Ann -> Doc Ann
operator (Text -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
op) Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
spacer)
            ([(Doc Ann, Doc Ann)] -> [(Doc Ann, Doc Ann)]
forall a. [a] -> [a]
reverse ((Doc Ann -> (Doc Ann, Doc Ann))
-> [Doc Ann] -> [(Doc Ann, Doc Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Ann -> (Doc Ann, Doc Ann)
forall a. a -> (a, a)
duplicate [Doc Ann]
docs))
      where
        prefix :: Doc Ann
prefix = if Text -> Int
Text.length Text
op Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Doc Ann
"  " else Doc Ann
"    "

        spacer :: Doc Ann
spacer = if Text -> Int
Text.length Text
op Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Doc Ann
" "  else Doc Ann
"  "

    prettyEquivalentExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyEquivalentExpression :: Expr Src a -> Doc Ann
prettyEquivalentExpression a0 :: Expr Src a
a0@(Equivalent Expr Src a
_ Expr Src a
_) =
        Text -> [Doc Ann] -> Doc Ann
prettyOperator (CharacterSet -> Text
equivalent CharacterSet
characterSet) (Expr Src a -> [Doc Ann]
forall a. Pretty a => Expr Src a -> [Doc Ann]
docs Expr Src a
a0)
      where
        docs :: Expr Src a -> [Doc Ann]
docs (Equivalent Expr Src a
a Expr Src a
b) = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportAltExpression Expr Src a
b Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
a
        docs Expr Src a
a
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
b <- Expr Src a
a =
                Expr Src a -> [Doc Ann]
docs Expr Src a
b
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportAltExpression Expr Src a
a ]
    prettyEquivalentExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyEquivalentExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportAltExpression Expr Src a
a

    prettyImportAltExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyImportAltExpression :: Expr Src a -> Doc Ann
prettyImportAltExpression a0 :: Expr Src a
a0@(ImportAlt Expr Src a
_ Expr Src a
_) =
        Text -> [Doc Ann] -> Doc Ann
prettyOperator Text
"?" (Expr Src a -> [Doc Ann]
forall a. Pretty a => Expr Src a -> [Doc Ann]
docs Expr Src a
a0)
      where
        docs :: Expr Src a -> [Doc Ann]
docs (ImportAlt Expr Src a
a Expr Src a
b) = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyOrExpression Expr Src a
b Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
a
        docs Expr Src a
a
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
b <- Expr Src a
a =
                Expr Src a -> [Doc Ann]
docs Expr Src a
b
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyOrExpression Expr Src a
a ]
    prettyImportAltExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportAltExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyOrExpression Expr Src a
a

    prettyOrExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyOrExpression :: Expr Src a -> Doc Ann
prettyOrExpression a0 :: Expr Src a
a0@(BoolOr Expr Src a
_ Expr Src a
_) =
        Text -> [Doc Ann] -> Doc Ann
prettyOperator Text
"||" (Expr Src a -> [Doc Ann]
forall a. Pretty a => Expr Src a -> [Doc Ann]
docs Expr Src a
a0)
      where
        docs :: Expr Src a -> [Doc Ann]
docs (BoolOr Expr Src a
a Expr Src a
b) = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPlusExpression Expr Src a
b Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
a
        docs Expr Src a
a
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
b <- Expr Src a
a =
                Expr Src a -> [Doc Ann]
docs Expr Src a
b
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPlusExpression Expr Src a
a ]
    prettyOrExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyOrExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPlusExpression Expr Src a
a

    prettyPlusExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyPlusExpression :: Expr Src a -> Doc Ann
prettyPlusExpression a0 :: Expr Src a
a0@(NaturalPlus Expr Src a
_ Expr Src a
_) =
        Text -> [Doc Ann] -> Doc Ann
prettyOperator Text
"+" (Expr Src a -> [Doc Ann]
forall a. Pretty a => Expr Src a -> [Doc Ann]
docs Expr Src a
a0)
      where
        docs :: Expr Src a -> [Doc Ann]
docs (NaturalPlus Expr Src a
a Expr Src a
b) = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyTextAppendExpression Expr Src a
b Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
a
        docs Expr Src a
a
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
b <- Expr Src a
a =
                Expr Src a -> [Doc Ann]
docs Expr Src a
b
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyTextAppendExpression Expr Src a
a ]
    prettyPlusExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPlusExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyTextAppendExpression Expr Src a
a

    prettyTextAppendExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyTextAppendExpression :: Expr Src a -> Doc Ann
prettyTextAppendExpression a0 :: Expr Src a
a0@(TextAppend Expr Src a
_ Expr Src a
_) =
        Text -> [Doc Ann] -> Doc Ann
prettyOperator Text
"++" (Expr Src a -> [Doc Ann]
forall a. Pretty a => Expr Src a -> [Doc Ann]
docs Expr Src a
a0)
      where
        docs :: Expr Src a -> [Doc Ann]
docs (TextAppend Expr Src a
a Expr Src a
b) = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyListAppendExpression Expr Src a
b Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
a
        docs Expr Src a
a
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
b <- Expr Src a
a =
                Expr Src a -> [Doc Ann]
docs Expr Src a
b
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyListAppendExpression Expr Src a
a ]
    prettyTextAppendExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyTextAppendExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyListAppendExpression Expr Src a
a

    prettyListAppendExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyListAppendExpression :: Expr Src a -> Doc Ann
prettyListAppendExpression a0 :: Expr Src a
a0@(ListAppend Expr Src a
_ Expr Src a
_) =
        Text -> [Doc Ann] -> Doc Ann
prettyOperator Text
"#" (Expr Src a -> [Doc Ann]
forall a. Pretty a => Expr Src a -> [Doc Ann]
docs Expr Src a
a0)
      where
        docs :: Expr Src a -> [Doc Ann]
docs (ListAppend Expr Src a
a Expr Src a
b) = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyAndExpression Expr Src a
b Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
a
        docs Expr Src a
a
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
b <- Expr Src a
a =
                Expr Src a -> [Doc Ann]
docs Expr Src a
b
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyAndExpression Expr Src a
a ]
    prettyListAppendExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyListAppendExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyAndExpression Expr Src a
a

    prettyAndExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyAndExpression :: Expr Src a -> Doc Ann
prettyAndExpression a0 :: Expr Src a
a0@(BoolAnd Expr Src a
_ Expr Src a
_) =
        Text -> [Doc Ann] -> Doc Ann
prettyOperator Text
"&&" (Expr Src a -> [Doc Ann]
forall a. Pretty a => Expr Src a -> [Doc Ann]
docs Expr Src a
a0)
      where
        docs :: Expr Src a -> [Doc Ann]
docs (BoolAnd Expr Src a
a Expr Src a
b) = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyCombineExpression Expr Src a
b Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
a
        docs Expr Src a
a
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
b <- Expr Src a
a =
                Expr Src a -> [Doc Ann]
docs Expr Src a
b
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyCombineExpression Expr Src a
a ]
    prettyAndExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyAndExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyCombineExpression Expr Src a
a

    prettyCombineExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyCombineExpression :: Expr Src a -> Doc Ann
prettyCombineExpression a0 :: Expr Src a
a0@(Combine Maybe Text
_ Expr Src a
_ Expr Src a
_) =
        Text -> [Doc Ann] -> Doc Ann
prettyOperator (CharacterSet -> Text
combine CharacterSet
characterSet) (Expr Src a -> [Doc Ann]
forall a. Pretty a => Expr Src a -> [Doc Ann]
docs Expr Src a
a0)
      where
        docs :: Expr Src a -> [Doc Ann]
docs (Combine Maybe Text
_ Expr Src a
a Expr Src a
b) = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPreferExpression Expr Src a
b Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
a
        docs Expr Src a
a
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
b <- Expr Src a
a =
                Expr Src a -> [Doc Ann]
docs Expr Src a
b
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPreferExpression Expr Src a
a ]
    prettyCombineExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyCombineExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPreferExpression Expr Src a
a

    prettyPreferExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyPreferExpression :: Expr Src a -> Doc Ann
prettyPreferExpression a0 :: Expr Src a
a0@(Prefer {}) =
        Text -> [Doc Ann] -> Doc Ann
prettyOperator (CharacterSet -> Text
prefer CharacterSet
characterSet) (Expr Src a -> [Doc Ann]
forall a. Pretty a => Expr Src a -> [Doc Ann]
docs Expr Src a
a0)
      where
        docs :: Expr Src a -> [Doc Ann]
docs (Prefer PreferAnnotation Src a
_ Expr Src a
a Expr Src a
b) = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyCombineTypesExpression Expr Src a
b Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
a
        docs Expr Src a
a
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
b <- Expr Src a
a =
                Expr Src a -> [Doc Ann]
docs Expr Src a
b
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyCombineTypesExpression Expr Src a
a ]
    prettyPreferExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPreferExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyCombineTypesExpression Expr Src a
a

    prettyCombineTypesExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyCombineTypesExpression :: Expr Src a -> Doc Ann
prettyCombineTypesExpression a0 :: Expr Src a
a0@(CombineTypes Expr Src a
_ Expr Src a
_) =
        Text -> [Doc Ann] -> Doc Ann
prettyOperator (CharacterSet -> Text
combineTypes CharacterSet
characterSet) (Expr Src a -> [Doc Ann]
forall a. Pretty a => Expr Src a -> [Doc Ann]
docs Expr Src a
a0)
      where
        docs :: Expr Src a -> [Doc Ann]
docs (CombineTypes Expr Src a
a Expr Src a
b) = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyTimesExpression Expr Src a
b Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
a
        docs Expr Src a
a
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
b <- Expr Src a
a =
                Expr Src a -> [Doc Ann]
docs Expr Src a
b
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyTimesExpression Expr Src a
a ]
    prettyCombineTypesExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyCombineTypesExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyTimesExpression Expr Src a
a

    prettyTimesExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyTimesExpression :: Expr Src a -> Doc Ann
prettyTimesExpression a0 :: Expr Src a
a0@(NaturalTimes Expr Src a
_ Expr Src a
_) =
        Text -> [Doc Ann] -> Doc Ann
prettyOperator Text
"*" (Expr Src a -> [Doc Ann]
forall a. Pretty a => Expr Src a -> [Doc Ann]
docs Expr Src a
a0)
      where
        docs :: Expr Src a -> [Doc Ann]
docs (NaturalTimes Expr Src a
a Expr Src a
b) = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyEqualExpression Expr Src a
b Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
a
        docs Expr Src a
a
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
b <- Expr Src a
a =
                Expr Src a -> [Doc Ann]
docs Expr Src a
b
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyEqualExpression Expr Src a
a ]
    prettyTimesExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyTimesExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyEqualExpression Expr Src a
a

    prettyEqualExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyEqualExpression :: Expr Src a -> Doc Ann
prettyEqualExpression a0 :: Expr Src a
a0@(BoolEQ Expr Src a
_ Expr Src a
_) =
        Text -> [Doc Ann] -> Doc Ann
prettyOperator Text
"==" (Expr Src a -> [Doc Ann]
forall a. Pretty a => Expr Src a -> [Doc Ann]
docs Expr Src a
a0)
      where
        docs :: Expr Src a -> [Doc Ann]
docs (BoolEQ Expr Src a
a Expr Src a
b) = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyNotEqualExpression Expr Src a
b Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
a
        docs Expr Src a
a
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
b <- Expr Src a
a =
                Expr Src a -> [Doc Ann]
docs Expr Src a
b
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyNotEqualExpression Expr Src a
a ]
    prettyEqualExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyEqualExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyNotEqualExpression Expr Src a
a

    prettyNotEqualExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyNotEqualExpression :: Expr Src a -> Doc Ann
prettyNotEqualExpression a0 :: Expr Src a
a0@(BoolNE Expr Src a
_ Expr Src a
_) =
        Text -> [Doc Ann] -> Doc Ann
prettyOperator Text
"!=" (Expr Src a -> [Doc Ann]
forall a. Pretty a => Expr Src a -> [Doc Ann]
docs Expr Src a
a0)
      where
        docs :: Expr Src a -> [Doc Ann]
docs (BoolNE Expr Src a
a Expr Src a
b) = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyApplicationExpression Expr Src a
b Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
a
        docs Expr Src a
a
            | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
b <- Expr Src a
a =
                Expr Src a -> [Doc Ann]
docs Expr Src a
b
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyApplicationExpression Expr Src a
a ]
    prettyNotEqualExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyNotEqualExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyApplicationExpression Expr Src a
a

    prettyApplicationExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyApplicationExpression :: Expr Src a -> Doc Ann
prettyApplicationExpression = [Expr Src a] -> Expr Src a -> Doc Ann
forall a. Pretty a => [Expr Src a] -> Expr Src a -> Doc Ann
go []
      where
        go :: [Expr Src a] -> Expr Src a -> Doc Ann
go [Expr Src a]
args = \case
            App Expr Src a
a Expr Src a
b           -> [Expr Src a] -> Expr Src a -> Doc Ann
go (Expr Src a
b Expr Src a -> [Expr Src a] -> [Expr Src a]
forall a. a -> [a] -> [a]
: [Expr Src a]
args) Expr Src a
a
            Some Expr Src a
a            -> Doc Ann -> [Expr Src a] -> Doc Ann
forall a. Pretty a => Doc Ann -> [Expr Src a] -> Doc Ann
app (Doc Ann -> Doc Ann
builtin Doc Ann
"Some") (Expr Src a
a Expr Src a -> [Expr Src a] -> [Expr Src a]
forall a. a -> [a] -> [a]
: [Expr Src a]
args)
            Merge Expr Src a
a Expr Src a
b Maybe (Expr Src a)
Nothing -> Doc Ann -> [Expr Src a] -> Doc Ann
forall a. Pretty a => Doc Ann -> [Expr Src a] -> Doc Ann
app (Doc Ann -> Doc Ann
keyword Doc Ann
"merge") (Expr Src a
a Expr Src a -> [Expr Src a] -> [Expr Src a]
forall a. a -> [a] -> [a]
: Expr Src a
b Expr Src a -> [Expr Src a] -> [Expr Src a]
forall a. a -> [a] -> [a]
: [Expr Src a]
args)
            ToMap Expr Src a
a Maybe (Expr Src a)
Nothing   -> Doc Ann -> [Expr Src a] -> Doc Ann
forall a. Pretty a => Doc Ann -> [Expr Src a] -> Doc Ann
app (Doc Ann -> Doc Ann
keyword Doc Ann
"toMap") (Expr Src a
a Expr Src a -> [Expr Src a] -> [Expr Src a]
forall a. a -> [a] -> [a]
: [Expr Src a]
args)
            Expr Src a
e | Note Src
_ Expr Src a
b <- Expr Src a
e ->
                  [Expr Src a] -> Expr Src a -> Doc Ann
go [Expr Src a]
args Expr Src a
b
              | [Expr Src a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expr Src a]
args ->
                  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression Expr Src a
e -- just a performance optimization
              | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
e ->
                  Doc Ann -> [Expr Src a] -> Doc Ann
forall a. Pretty a => Doc Ann -> [Expr Src a] -> Doc Ann
app Doc Ann
doc [Expr Src a]
args
              | Bool
otherwise ->
                  Doc Ann -> [Expr Src a] -> Doc Ann
forall a. Pretty a => Doc Ann -> [Expr Src a] -> Doc Ann
app (Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression Expr Src a
e) [Expr Src a]
args

        app :: Doc Ann -> [Expr Src a] -> Doc Ann
app Doc Ann
f [Expr Src a]
args =
            Doc Ann
-> Doc Ann -> Doc Ann -> Doc Ann -> [(Doc Ann, Doc Ann)] -> Doc Ann
forall ann.
Doc ann
-> Doc ann -> Doc ann -> Doc ann -> [(Doc ann, Doc ann)] -> Doc ann
enclose'
                Doc Ann
"" Doc Ann
"" Doc Ann
" " Doc Ann
""
                ( Doc Ann -> (Doc Ann, Doc Ann)
forall a. a -> (a, a)
duplicate Doc Ann
f
                (Doc Ann, Doc Ann) -> [(Doc Ann, Doc Ann)] -> [(Doc Ann, Doc Ann)]
forall a. a -> [a] -> [a]
: (Expr Src a -> (Doc Ann, Doc Ann))
-> [Expr Src a] -> [(Doc Ann, Doc Ann)]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc Ann -> Doc Ann) -> (Doc Ann, Doc Ann) -> (Doc Ann, Doc Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Doc Ann -> Doc Ann
forall ann. Int -> Doc ann -> Doc ann
Pretty.indent Int
2) ((Doc Ann, Doc Ann) -> (Doc Ann, Doc Ann))
-> (Expr Src a -> (Doc Ann, Doc Ann))
-> Expr Src a
-> (Doc Ann, Doc Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Ann -> (Doc Ann, Doc Ann)
forall a. a -> (a, a)
duplicate (Doc Ann -> (Doc Ann, Doc Ann))
-> (Expr Src a -> Doc Ann) -> Expr Src a -> (Doc Ann, Doc Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression) [Expr Src a]
args
                )

    prettyImportExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyImportExpression :: Expr Src a -> Doc Ann
prettyImportExpression (Embed a
a) =
        a -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty a
a
    prettyImportExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyCompletionExpression Expr Src a
a

    prettyCompletionExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyCompletionExpression :: Expr Src a -> Doc Ann
prettyCompletionExpression (RecordCompletion Expr Src a
a Expr Src a
b) =
        case Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
b of
            RecordLit Map Text (Expr Src a)
kvs ->
                Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
                    (   Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettySelectorExpression Expr Src a
a
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
doubleColon
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Int -> Map Text (Expr Src a) -> Doc Ann
forall a. Pretty a => Int -> Map Text (Expr Src a) -> Doc Ann
prettyCompletionLit Int
0 Map Text (Expr Src a)
kvs
                    )
            Expr Src a
_ ->    Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettySelectorExpression Expr Src a
a
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
doubleColon
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettySelectorExpression Expr Src a
b
    prettyCompletionExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyCompletionExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettySelectorExpression Expr Src a
a

    prettySelectorExpression :: Pretty a => Expr Src a -> Doc Ann
    prettySelectorExpression :: Expr Src a -> Doc Ann
prettySelectorExpression (Field Expr Src a
a Text
b) =
        Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettySelectorExpression Expr Src a
a Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
dot Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Ann
prettyAnyLabel Text
b
    prettySelectorExpression (Project Expr Src a
a (Left Set Text
b)) =
        Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettySelectorExpression Expr Src a
a Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
dot Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Set Text -> Doc Ann
prettyLabels Set Text
b
    prettySelectorExpression (Project Expr Src a
a (Right Expr Src a
b)) =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettySelectorExpression Expr Src a
a
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
dot
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
lparen
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Expr Src a
b
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
rparen
    prettySelectorExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettySelectorExpression Expr Src a
b
        | Bool
otherwise =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
a

    prettyPrimitiveExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyPrimitiveExpression :: Expr Src a -> Doc Ann
prettyPrimitiveExpression (Var Var
a) =
        Var -> Doc Ann
prettyVar Var
a
    prettyPrimitiveExpression (Const Const
k) =
        Const -> Doc Ann
prettyConst Const
k
    prettyPrimitiveExpression Expr Src a
Bool =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Bool"
    prettyPrimitiveExpression Expr Src a
Natural =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural"
    prettyPrimitiveExpression Expr Src a
NaturalFold =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/fold"
    prettyPrimitiveExpression Expr Src a
NaturalBuild =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/build"
    prettyPrimitiveExpression Expr Src a
NaturalIsZero =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/isZero"
    prettyPrimitiveExpression Expr Src a
NaturalEven =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/even"
    prettyPrimitiveExpression Expr Src a
NaturalOdd =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/odd"
    prettyPrimitiveExpression Expr Src a
NaturalToInteger =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/toInteger"
    prettyPrimitiveExpression Expr Src a
NaturalShow =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/show"
    prettyPrimitiveExpression Expr Src a
NaturalSubtract =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/subtract"
    prettyPrimitiveExpression Expr Src a
Integer =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Integer"
    prettyPrimitiveExpression Expr Src a
IntegerClamp =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Integer/clamp"
    prettyPrimitiveExpression Expr Src a
IntegerNegate =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Integer/negate"
    prettyPrimitiveExpression Expr Src a
IntegerShow =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Integer/show"
    prettyPrimitiveExpression Expr Src a
IntegerToDouble =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Integer/toDouble"
    prettyPrimitiveExpression Expr Src a
Double =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Double"
    prettyPrimitiveExpression Expr Src a
DoubleShow =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Double/show"
    prettyPrimitiveExpression Expr Src a
Text =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Text"
    prettyPrimitiveExpression Expr Src a
TextShow =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Text/show"
    prettyPrimitiveExpression Expr Src a
List =
        Doc Ann -> Doc Ann
builtin Doc Ann
"List"
    prettyPrimitiveExpression Expr Src a
ListBuild =
        Doc Ann -> Doc Ann
builtin Doc Ann
"List/build"
    prettyPrimitiveExpression Expr Src a
ListFold =
        Doc Ann -> Doc Ann
builtin Doc Ann
"List/fold"
    prettyPrimitiveExpression Expr Src a
ListLength =
        Doc Ann -> Doc Ann
builtin Doc Ann
"List/length"
    prettyPrimitiveExpression Expr Src a
ListHead =
        Doc Ann -> Doc Ann
builtin Doc Ann
"List/head"
    prettyPrimitiveExpression Expr Src a
ListLast =
        Doc Ann -> Doc Ann
builtin Doc Ann
"List/last"
    prettyPrimitiveExpression Expr Src a
ListIndexed =
        Doc Ann -> Doc Ann
builtin Doc Ann
"List/indexed"
    prettyPrimitiveExpression Expr Src a
ListReverse =
        Doc Ann -> Doc Ann
builtin Doc Ann
"List/reverse"
    prettyPrimitiveExpression Expr Src a
Optional =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Optional"
    prettyPrimitiveExpression Expr Src a
None =
        Doc Ann -> Doc Ann
builtin Doc Ann
"None"
    prettyPrimitiveExpression (BoolLit Bool
True) =
        Doc Ann -> Doc Ann
builtin Doc Ann
"True"
    prettyPrimitiveExpression (BoolLit Bool
False) =
        Doc Ann -> Doc Ann
builtin Doc Ann
"False"
    prettyPrimitiveExpression (IntegerLit Integer
a)
        | Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
a    = Doc Ann -> Doc Ann
literal Doc Ann
"+" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Integer -> Doc Ann
prettyNumber Integer
a
        | Bool
otherwise = Integer -> Doc Ann
prettyNumber Integer
a
    prettyPrimitiveExpression (NaturalLit Natural
a) =
        Natural -> Doc Ann
prettyNatural Natural
a
    prettyPrimitiveExpression (DoubleLit (DhallDouble Double
a)) =
        Double -> Doc Ann
prettyDouble Double
a
    prettyPrimitiveExpression (TextLit Chunks Src a
a) =
        Chunks Src a -> Doc Ann
forall a. Pretty a => Chunks Src a -> Doc Ann
prettyChunks Chunks Src a
a
    prettyPrimitiveExpression (Record Map Text (Expr Src a)
a) =
        Map Text (Expr Src a) -> Doc Ann
forall a. Pretty a => Map Text (Expr Src a) -> Doc Ann
prettyRecord Map Text (Expr Src a)
a
    prettyPrimitiveExpression (RecordLit Map Text (Expr Src a)
a) =
        Map Text (Expr Src a) -> Doc Ann
forall a. Pretty a => Map Text (Expr Src a) -> Doc Ann
prettyRecordLit Map Text (Expr Src a)
a
    prettyPrimitiveExpression (Union Map Text (Maybe (Expr Src a))
a) =
        Map Text (Maybe (Expr Src a)) -> Doc Ann
forall a. Pretty a => Map Text (Maybe (Expr Src a)) -> Doc Ann
prettyUnion Map Text (Maybe (Expr Src a))
a
    prettyPrimitiveExpression (ListLit Maybe (Expr Src a)
Nothing Seq (Expr Src a)
b) =
        [Doc Ann] -> Doc Ann
list ((Expr Src a -> Doc Ann) -> [Expr Src a] -> [Doc Ann]
forall a b. (a -> b) -> [a] -> [b]
map Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression (Seq (Expr Src a) -> [Expr Src a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Seq (Expr Src a)
b))
    prettyPrimitiveExpression Expr Src a
a
        | Just Doc Ann
doc <- Expr Src a -> Maybe (Doc Ann)
forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
b
        | Bool
otherwise =
            Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short)
      where
        long :: Doc Ann
long =
            Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
                (Doc Ann
lparen Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Expr Src a
a Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
Pretty.hardline Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
rparen)

        short :: Doc Ann
short = Doc Ann
lparen Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Expr Src a
a Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
rparen

    prettyKeyValue
        :: Pretty a
        => (k -> Doc Ann)
        -> (Expr Src a -> Doc Ann)
        -> Doc Ann
        -> (k, Expr Src a)
        -> (Doc Ann, Doc Ann)
    prettyKeyValue :: (k -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> (k, Expr Src a)
-> (Doc Ann, Doc Ann)
prettyKeyValue k -> Doc Ann
prettyKey Expr Src a -> Doc Ann
prettyValue Doc Ann
separator (k
key, Expr Src a
val) =
        Doc Ann -> (Doc Ann, Doc Ann)
forall a. a -> (a, a)
duplicate (Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short))
      where
        completion :: Expr Src a -> Expr Src a -> Doc Ann
completion Expr Src a
_T Expr Src a
r =
                Doc Ann
" "
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettySelectorExpression Expr Src a
_T
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
doubleColon
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  case Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
r of
                    RecordLit Map Text (Expr Src a)
kvs ->
                        Int -> Map Text (Expr Src a) -> Doc Ann
forall a. Pretty a => Int -> Map Text (Expr Src a) -> Doc Ann
prettyCompletionLit Int
2 Map Text (Expr Src a)
kvs
                    Expr Src a
_ ->
                        Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettySelectorExpression Expr Src a
r

        short :: Doc Ann
short = k -> Doc Ann
prettyKey k
key
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
" "
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
separator
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
" "
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyValue Expr Src a
val

        long :: Doc Ann
long =
                k -> Doc Ann
prettyKey k
key
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
" "
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
separator
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  case Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
val of
                    Some Expr Src a
val' ->
                            Doc Ann
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> Doc Ann
builtin Doc Ann
"Some"
                        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  case Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
val' of
                                RecordCompletion Expr Src a
_T Expr Src a
r ->
                                    Expr Src a -> Expr Src a -> Doc Ann
forall a a.
(Pretty a, Pretty a) =>
Expr Src a -> Expr Src a -> Doc Ann
completion Expr Src a
_T Expr Src a
r

                                RecordLit Map Text (Expr Src a)
_ ->
                                        Doc Ann
forall ann. Doc ann
Pretty.hardline
                                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"  "
                                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression Expr Src a
val'

                                ListLit Maybe (Expr Src a)
_ Seq (Expr Src a)
xs
                                    | Bool -> Bool
not (Seq (Expr Src a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (Expr Src a)
xs) ->
                                            Doc Ann
forall ann. Doc ann
Pretty.hardline
                                        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"  "
                                        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression Expr Src a
val'

                                Expr Src a
_ ->    Doc Ann
forall ann. Doc ann
Pretty.hardline
                                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"    "
                                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression Expr Src a
val'

                    ToMap Expr Src a
val' Maybe (Expr Src a)
Nothing ->
                            Doc Ann
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> Doc Ann
keyword Doc Ann
"toMap"
                        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  case Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
val' of
                                RecordCompletion Expr Src a
_T Expr Src a
r ->
                                    Expr Src a -> Expr Src a -> Doc Ann
forall a a.
(Pretty a, Pretty a) =>
Expr Src a -> Expr Src a -> Doc Ann
completion Expr Src a
_T Expr Src a
r
                                Expr Src a
_ ->    Doc Ann
forall ann. Doc ann
Pretty.hardline
                                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"    "
                                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression Expr Src a
val'

                    RecordCompletion Expr Src a
_T Expr Src a
r ->
                        Expr Src a -> Expr Src a -> Doc Ann
forall a a.
(Pretty a, Pretty a) =>
Expr Src a -> Expr Src a -> Doc Ann
completion Expr Src a
_T Expr Src a
r

                    RecordLit Map Text (Expr Src a)
_ ->
                            Doc Ann
forall ann. Doc ann
Pretty.hardline
                        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"  "
                        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyValue Expr Src a
val

                    ListLit Maybe (Expr Src a)
_ Seq (Expr Src a)
xs
                        | Bool -> Bool
not (Seq (Expr Src a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (Expr Src a)
xs) ->
                                Doc Ann
forall ann. Doc ann
Pretty.hardline
                            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"  "
                            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyValue Expr Src a
val

                    Expr Src a
_ -> 
                            Doc Ann
forall ann. Doc ann
Pretty.hardline
                        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"    "
                        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyValue Expr Src a
val

    prettyRecord :: Pretty a => Map Text (Expr Src a) -> Doc Ann
    prettyRecord :: Map Text (Expr Src a) -> Doc Ann
prettyRecord =
          [(Doc Ann, Doc Ann)] -> Doc Ann
braces
        ([(Doc Ann, Doc Ann)] -> Doc Ann)
-> (Map Text (Expr Src a) -> [(Doc Ann, Doc Ann)])
-> Map Text (Expr Src a)
-> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Expr Src a) -> (Doc Ann, Doc Ann))
-> [(Text, Expr Src a)] -> [(Doc Ann, Doc Ann)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> (Text, Expr Src a)
-> (Doc Ann, Doc Ann)
forall a k.
Pretty a =>
(k -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> (k, Expr Src a)
-> (Doc Ann, Doc Ann)
prettyKeyValue Text -> Doc Ann
prettyAnyLabel Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Doc Ann
colon)
        ([(Text, Expr Src a)] -> [(Doc Ann, Doc Ann)])
-> (Map Text (Expr Src a) -> [(Text, Expr Src a)])
-> Map Text (Expr Src a)
-> [(Doc Ann, Doc Ann)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text (Expr Src a) -> [(Text, Expr Src a)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList

    prettyRecordLit :: Pretty a => Map Text (Expr Src a) -> Doc Ann
    prettyRecordLit :: Map Text (Expr Src a) -> Doc Ann
prettyRecordLit = ([(Doc Ann, Doc Ann)] -> Doc Ann)
-> Map Text (Expr Src a) -> Doc Ann
forall a.
Pretty a =>
([(Doc Ann, Doc Ann)] -> Doc Ann)
-> Map Text (Expr Src a) -> Doc Ann
prettyRecordLike [(Doc Ann, Doc Ann)] -> Doc Ann
braces

    prettyCompletionLit :: Pretty a => Int -> Map Text (Expr Src a) -> Doc Ann
    prettyCompletionLit :: Int -> Map Text (Expr Src a) -> Doc Ann
prettyCompletionLit = ([(Doc Ann, Doc Ann)] -> Doc Ann)
-> Map Text (Expr Src a) -> Doc Ann
forall a.
Pretty a =>
([(Doc Ann, Doc Ann)] -> Doc Ann)
-> Map Text (Expr Src a) -> Doc Ann
prettyRecordLike (([(Doc Ann, Doc Ann)] -> Doc Ann)
 -> Map Text (Expr Src a) -> Doc Ann)
-> (Int -> [(Doc Ann, Doc Ann)] -> Doc Ann)
-> Int
-> Map Text (Expr Src a)
-> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Doc Ann, Doc Ann)] -> Doc Ann
hangingBraces

    prettyRecordLike :: ([(Doc Ann, Doc Ann)] -> Doc Ann)
-> Map Text (Expr Src a) -> Doc Ann
prettyRecordLike [(Doc Ann, Doc Ann)] -> Doc Ann
braceStyle Map Text (Expr Src a)
a
        | Map Text (Expr Src a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Data.Foldable.null Map Text (Expr Src a)
a =
            Doc Ann
lbrace Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
equals Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
rbrace
        | Bool
otherwise =
            [(Doc Ann, Doc Ann)] -> Doc Ann
braceStyle (((NonEmpty Text, Expr Src a) -> (Doc Ann, Doc Ann))
-> [(NonEmpty Text, Expr Src a)] -> [(Doc Ann, Doc Ann)]
forall a b. (a -> b) -> [a] -> [b]
map (NonEmpty Text, Expr Src a) -> (Doc Ann, Doc Ann)
forall a.
Pretty a =>
(NonEmpty Text, Expr Src a) -> (Doc Ann, Doc Ann)
prettyRecordEntry (Map (NonEmpty Text) (Expr Src a) -> [(NonEmpty Text, Expr Src a)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map (NonEmpty Text) (Expr Src a)
consolidated))
      where
        consolidated :: Map (NonEmpty Text) (Expr Src a)
consolidated = Map Text (Expr Src a) -> Map (NonEmpty Text) (Expr Src a)
forall s a. Map Text (Expr s a) -> Map (NonEmpty Text) (Expr s a)
consolidateRecordLiteral Map Text (Expr Src a)
a

        prettyRecordEntry :: (NonEmpty Text, Expr Src a) -> (Doc Ann, Doc Ann)
prettyRecordEntry (NonEmpty Text
keys, Expr Src a
value) =
            case NonEmpty Text
keys of
                Text
key :| []
                    | Var (V Text
key' Int
0) <- Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a
Dhall.Syntax.shallowDenote Expr Src a
value
                    , Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
key' ->
                        Doc Ann -> (Doc Ann, Doc Ann)
forall a. a -> (a, a)
duplicate (Text -> Doc Ann
prettyAnyLabel Text
key)
                NonEmpty Text
_ ->
                    (NonEmpty Text -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> (NonEmpty Text, Expr Src a)
-> (Doc Ann, Doc Ann)
forall a k.
Pretty a =>
(k -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> (k, Expr Src a)
-> (Doc Ann, Doc Ann)
prettyKeyValue NonEmpty Text -> Doc Ann
forall (list :: * -> *). Foldable list => list Text -> Doc Ann
prettyAnyLabels Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Doc Ann
equals (NonEmpty Text
keys, Expr Src a
value)

    prettyAlternative :: (Text, Maybe (Expr Src a)) -> (Doc Ann, Doc Ann)
prettyAlternative (Text
key, Just Expr Src a
val) =
        (Text -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> (Text, Expr Src a)
-> (Doc Ann, Doc Ann)
forall a k.
Pretty a =>
(k -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> (k, Expr Src a)
-> (Doc Ann, Doc Ann)
prettyKeyValue Text -> Doc Ann
prettyAnyLabel Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Doc Ann
colon (Text
key, Expr Src a
val)
    prettyAlternative (Text
key, Maybe (Expr Src a)
Nothing) =
        Doc Ann -> (Doc Ann, Doc Ann)
forall a. a -> (a, a)
duplicate (Text -> Doc Ann
prettyAnyLabel Text
key)

    prettyUnion :: Pretty a => Map Text (Maybe (Expr Src a)) -> Doc Ann
    prettyUnion :: Map Text (Maybe (Expr Src a)) -> Doc Ann
prettyUnion =
        [(Doc Ann, Doc Ann)] -> Doc Ann
angles ([(Doc Ann, Doc Ann)] -> Doc Ann)
-> (Map Text (Maybe (Expr Src a)) -> [(Doc Ann, Doc Ann)])
-> Map Text (Maybe (Expr Src a))
-> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Maybe (Expr Src a)) -> (Doc Ann, Doc Ann))
-> [(Text, Maybe (Expr Src a))] -> [(Doc Ann, Doc Ann)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Maybe (Expr Src a)) -> (Doc Ann, Doc Ann)
forall a.
Pretty a =>
(Text, Maybe (Expr Src a)) -> (Doc Ann, Doc Ann)
prettyAlternative ([(Text, Maybe (Expr Src a))] -> [(Doc Ann, Doc Ann)])
-> (Map Text (Maybe (Expr Src a)) -> [(Text, Maybe (Expr Src a))])
-> Map Text (Maybe (Expr Src a))
-> [(Doc Ann, Doc Ann)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text (Maybe (Expr Src a)) -> [(Text, Maybe (Expr Src a))]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList

    prettyChunks :: Pretty a => Chunks Src a -> Doc Ann
    prettyChunks :: Chunks Src a -> Doc Ann
prettyChunks chunks :: Chunks Src a
chunks@(Chunks [(Text, Expr Src a)]
a Text
b)
        | (Char -> Bool) -> Bool
anyText (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') =
            if Bool -> Bool
not ([(Text, Expr Src a)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Expr Src a)]
a) Bool -> Bool -> Bool
|| (Char -> Bool) -> Bool
anyText (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
            then Doc Ann
long
            else Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short)
        | Bool
otherwise =
            Doc Ann
short
      where
        long :: Doc Ann
long =
            Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
            (   Doc Ann -> Doc Ann
literal Doc Ann
"''" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
Pretty.hardline
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
                (((Text, Expr Src a) -> Doc Ann) -> [(Text, Expr Src a)] -> Doc Ann
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text, Expr Src a) -> Doc Ann
forall a. Pretty a => (Text, Expr Src a) -> Doc Ann
prettyMultilineChunk [(Text, Expr Src a)]
a' Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Ann
prettyMultilineText Text
b')
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann -> Doc Ann
literal Doc Ann
"''"
            )
          where
            Chunks [(Text, Expr Src a)]
a' Text
b' = Chunks Src a -> Chunks Src a
forall s a. Chunks s a -> Chunks s a
multilineChunks Chunks Src a
chunks

        short :: Doc Ann
short =
            Doc Ann -> Doc Ann
literal Doc Ann
"\"" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> ((Text, Expr Src a) -> Doc Ann) -> [(Text, Expr Src a)] -> Doc Ann
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text, Expr Src a) -> Doc Ann
forall a. Pretty a => (Text, Expr Src a) -> Doc Ann
prettyChunk [(Text, Expr Src a)]
a Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> Doc Ann
literal (Text -> Doc Ann
prettyText Text
b Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\"")

        anyText :: (Char -> Bool) -> Bool
anyText Char -> Bool
predicate = ((Text, Expr Src a) -> Bool) -> [(Text, Expr Src a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(Text
text, Expr Src a
_) -> (Char -> Bool) -> Text -> Bool
Text.any Char -> Bool
predicate Text
text) [(Text, Expr Src a)]
a Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
Text.any Char -> Bool
predicate Text
b

        prettyMultilineChunk :: (Text, Expr Src a) -> Doc Ann
prettyMultilineChunk (Text
c, Expr Src a
d) =
                Text -> Doc Ann
prettyMultilineText Text
c
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
dollar
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
lbrace
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Expr Src a
d
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
rbrace

        prettyMultilineText :: Text -> Doc Ann
prettyMultilineText Text
text = [Doc Ann] -> Doc Ann
forall a. Monoid a => [a] -> a
mconcat [Doc Ann]
docs
          where
            lines_ :: [Text]
lines_ = Text -> Text -> [Text]
Text.splitOn Text
"\n" (Text -> Text
escapeSingleQuotedText Text
text)

            -- Annotate only non-empty lines so trailing whitespace can be
            -- removed on empty ones.
            prettyLine :: Text -> Doc Ann
prettyLine Text
line =
                (if Text -> Bool
Text.null Text
line then Doc Ann -> Doc Ann
forall a. a -> a
id else Doc Ann -> Doc Ann
literal)
                    (Text -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
line)

            docs :: [Doc Ann]
docs =
                Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
Data.List.intersperse Doc Ann
forall ann. Doc ann
Pretty.hardline ((Text -> Doc Ann) -> [Text] -> [Doc Ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc Ann
prettyLine [Text]
lines_)

        prettyChunk :: (Text, Expr Src a) -> Doc Ann
prettyChunk (Text
c, Expr Src a
d) =
                Text -> Doc Ann
prettyText Text
c
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann -> Doc Ann
syntax Doc Ann
"${"
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Expr Src a
d
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann -> Doc Ann
syntax Doc Ann
rbrace

        prettyText :: Text -> Doc Ann
prettyText Text
t = Doc Ann -> Doc Ann
literal (Text -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (Text -> Text
escapeText_ Text
t))


-- | Prepare 'Chunks' for multi-line formatting by escaping problematic
-- character sequences via string interpolations
--
-- >>> multilineChunks (Chunks [] "\n \tx")
-- Chunks [("\n",TextLit (Chunks [] " \t"))] "x"
-- >>> multilineChunks (Chunks [] "\n\NUL\b\f\t")
-- Chunks [("\n",TextLit (Chunks [] "\NUL\b\f"))] "\t"
multilineChunks :: Chunks s a -> Chunks s a
multilineChunks :: Chunks s a -> Chunks s a
multilineChunks =
     Chunks s a -> Chunks s a
forall s a. Chunks s a -> Chunks s a
escapeTrailingSingleQuote
   (Chunks s a -> Chunks s a)
-> (Chunks s a -> Chunks s a) -> Chunks s a -> Chunks s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunks s a -> Chunks s a
forall s a. Chunks s a -> Chunks s a
escapeControlCharacters
   (Chunks s a -> Chunks s a)
-> (Chunks s a -> Chunks s a) -> Chunks s a -> Chunks s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunks s a -> Chunks s a
forall s a. Chunks s a -> Chunks s a
escapeSharedWhitespacePrefix

-- | Escape any leading whitespace shared by all lines
--
-- This ensures that significant shared leading whitespace is not stripped
--
-- >>> escapeSharedWhitespacePrefix (Chunks [] "\n \tx")
-- Chunks [("\n",TextLit (Chunks [] " \t"))] "x"
-- >>> escapeSharedWhitespacePrefix (Chunks [("\n",Var (V "x" 0))] " ")
-- Chunks [("\n",Var (V "x" 0))] " "
-- >>> escapeSharedWhitespacePrefix (Chunks [("\n ",Var (V "x" 0))] "")
-- Chunks [("\n",TextLit (Chunks [] " ")),("",Var (V "x" 0))] ""
-- >>> escapeSharedWhitespacePrefix (Chunks [("\n ",Var (V "x" 0))] "\n")
-- Chunks [("\n ",Var (V "x" 0))] "\n"
-- >>> escapeSharedWhitespacePrefix (Chunks [] " ")
-- Chunks [("",TextLit (Chunks [] " "))] ""
escapeSharedWhitespacePrefix :: Chunks s a -> Chunks s a
escapeSharedWhitespacePrefix :: Chunks s a -> Chunks s a
escapeSharedWhitespacePrefix Chunks s a
literal_ = NonEmpty (Chunks s a) -> Chunks s a
forall s a. NonEmpty (Chunks s a) -> Chunks s a
unlinesLiteral NonEmpty (Chunks s a)
literals₁
  where
    literals₀ :: NonEmpty (Chunks s a)
literals₀ = Chunks s a -> NonEmpty (Chunks s a)
forall s a. Chunks s a -> NonEmpty (Chunks s a)
linesLiteral Chunks s a
literal_

    sharedPrefix :: Text
sharedPrefix = NonEmpty (Chunks s a) -> Text
forall s a. NonEmpty (Chunks s a) -> Text
longestSharedWhitespacePrefix NonEmpty (Chunks s a)
literals₀

    stripPrefix :: Text -> Text
stripPrefix = Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
sharedPrefix)

    escapeSharedPrefix :: Chunks s a -> Chunks s a
escapeSharedPrefix (Chunks [] Text
prefix₀)
        | Text -> Text -> Bool
Text.isPrefixOf Text
sharedPrefix Text
prefix₀ =
            [(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [ (Text
"", Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
sharedPrefix)) ] Text
prefix₁
      where
        prefix₁ :: Text
prefix₁ = Text -> Text
stripPrefix Text
prefix₀
    escapeSharedPrefix (Chunks ((Text
prefix₀, Expr s a
y) : [(Text, Expr s a)]
xys) Text
z)
        | Text -> Text -> Bool
Text.isPrefixOf Text
sharedPrefix Text
prefix₀ =
            [(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks ((Text
"", Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
sharedPrefix)) (Text, Expr s a) -> [(Text, Expr s a)] -> [(Text, Expr s a)]
forall a. a -> [a] -> [a]
: (Text
prefix₁, Expr s a
y) (Text, Expr s a) -> [(Text, Expr s a)] -> [(Text, Expr s a)]
forall a. a -> [a] -> [a]
: [(Text, Expr s a)]
xys) Text
z
      where
        prefix₁ :: Text
prefix₁ = Text -> Text
stripPrefix Text
prefix₀
    escapeSharedPrefix Chunks s a
line = Chunks s a
line

    literals₁ :: NonEmpty (Chunks s a)
literals₁
        | Bool -> Bool
not (Text -> Bool
Text.null Text
sharedPrefix) = (Chunks s a -> Chunks s a)
-> NonEmpty (Chunks s a) -> NonEmpty (Chunks s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Chunks s a -> Chunks s a
forall s a. Chunks s a -> Chunks s a
escapeSharedPrefix NonEmpty (Chunks s a)
literals₀
        | Bool
otherwise = NonEmpty (Chunks s a)
literals₀

-- | Escape control characters by moving them into string interpolations
--
-- >>> escapeControlCharacters (Chunks [] "\n\NUL\b\f\t")
-- Chunks [("\n",TextLit (Chunks [] "\NUL\b\f"))] "\t"
escapeControlCharacters :: Chunks s a -> Chunks s a
escapeControlCharacters :: Chunks s a -> Chunks s a
escapeControlCharacters (Chunks [(Text, Expr s a)]
as0 Text
b0) = [(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [(Text, Expr s a)]
as1 Text
b1
  where
    as1 :: [(Text, Expr s a)]
as1 = ((Text, Expr s a) -> [(Text, Expr s a)] -> [(Text, Expr s a)])
-> [(Text, Expr s a)] -> [(Text, Expr s a)] -> [(Text, Expr s a)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text, Expr s a) -> [(Text, Expr s a)] -> [(Text, Expr s a)]
forall s a.
(Text, Expr s a) -> [(Text, Expr s a)] -> [(Text, Expr s a)]
f (((Text, Text) -> (Text, Expr s a))
-> [(Text, Text)] -> [(Text, Expr s a)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> (Text, Expr s a)
forall a s a. (a, Text) -> (a, Expr s a)
toChunk [(Text, Text)]
bs) [(Text, Expr s a)]
as0

    ([(Text, Text)]
bs, Text
b1) = (Char -> Bool) -> Text -> ([(Text, Text)], Text)
splitOnPredicate Char -> Bool
predicate Text
b0

    f :: (Text, Expr s a) -> [(Text, Expr s a)] -> [(Text, Expr s a)]
f (Text
t0, Expr s a
e) [(Text, Expr s a)]
chunks = ((Text, Text) -> (Text, Expr s a))
-> [(Text, Text)] -> [(Text, Expr s a)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> (Text, Expr s a)
forall a s a. (a, Text) -> (a, Expr s a)
toChunk [(Text, Text)]
ts1 [(Text, Expr s a)] -> [(Text, Expr s a)] -> [(Text, Expr s a)]
forall a. [a] -> [a] -> [a]
++ (Text
t1, Expr s a
e) (Text, Expr s a) -> [(Text, Expr s a)] -> [(Text, Expr s a)]
forall a. a -> [a] -> [a]
: [(Text, Expr s a)]
chunks
      where
        ([(Text, Text)]
ts1, Text
t1) = (Char -> Bool) -> Text -> ([(Text, Text)], Text)
splitOnPredicate Char -> Bool
predicate Text
t0

    predicate :: Char -> Bool
predicate Char
c = Char -> Bool
Data.Char.isControl Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\t' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n'

    toChunk :: (a, Text) -> (a, Expr s a)
toChunk (a
t0, Text
t1) = (a
t0, Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
t1))

-- | Split `Text` on a predicate, preserving all parts of the original string.
--
-- >>> splitOnPredicate (== 'x') ""
-- ([],"")
-- >>> splitOnPredicate (== 'x') " xx "
-- ([(" ","xx")]," ")
-- >>> splitOnPredicate (== 'x') "xx"
-- ([("","xx")],"")
--
-- prop> \(Fun _ p) s -> let {t = Text.pack s; (as, b) = splitOnPredicate p t} in foldMap (uncurry (<>)) as <> b == t
splitOnPredicate :: (Char -> Bool) -> Text -> ([(Text, Text)], Text)
splitOnPredicate :: (Char -> Bool) -> Text -> ([(Text, Text)], Text)
splitOnPredicate Char -> Bool
p Text
t = case (Char -> Bool) -> Text -> (Text, Text)
Text.break Char -> Bool
p Text
t of
    (Text
a, Text
"") -> ([], Text
a)
    (Text
a, Text
b)  -> case (Char -> Bool) -> Text -> (Text, Text)
Text.span Char -> Bool
p Text
b of
        (Text
c, Text
d) -> case (Char -> Bool) -> Text -> ([(Text, Text)], Text)
splitOnPredicate Char -> Bool
p Text
d of
            ([(Text, Text)]
e, Text
f) -> ((Text
a, Text
c) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
e, Text
f)

-- | Escape a trailing single quote by moving it into a string interpolation
--
-- Otherwise the multiline-string would end with @'''@, which would be parsed
-- as an escaped @''@.
--
-- >>> escapeTrailingSingleQuote (Chunks [] "\n'")
-- Chunks [("\n",TextLit (Chunks [] "'"))] ""
escapeTrailingSingleQuote :: Chunks s a -> Chunks s a
escapeTrailingSingleQuote :: Chunks s a -> Chunks s a
escapeTrailingSingleQuote chunks :: Chunks s a
chunks@(Chunks [(Text, Expr s a)]
as Text
b) =
    case Text -> Maybe (Text, Char)
Text.unsnoc Text
b of
        Just (Text
b', Char
'\'') -> [(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks ([(Text, Expr s a)]
as [(Text, Expr s a)] -> [(Text, Expr s a)] -> [(Text, Expr s a)]
forall a. [a] -> [a] -> [a]
++ [(Text
b', Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
"'"))]) Text
""
        Maybe (Text, Char)
_               -> Chunks s a
chunks

-- | Pretty-print a value
pretty_ :: Pretty a => a -> Text
pretty_ :: a -> Text
pretty_ = a -> Text
forall a. Pretty a => a -> Text
prettyToStrictText

{- This utility function converts
   `{ x = { y = { z = 1 } } }` to `{ x.y.z. = 1 }`
-}
consolidateRecordLiteral
    :: Map Text (Expr s a) -> Map (NonEmpty Text) (Expr s a)
consolidateRecordLiteral :: Map Text (Expr s a) -> Map (NonEmpty Text) (Expr s a)
consolidateRecordLiteral = [(NonEmpty Text, Expr s a)] -> Map (NonEmpty Text) (Expr s a)
forall k v. Ord k => [(k, v)] -> Map k v
Map.fromList ([(NonEmpty Text, Expr s a)] -> Map (NonEmpty Text) (Expr s a))
-> (Map Text (Expr s a) -> [(NonEmpty Text, Expr s a)])
-> Map Text (Expr s a)
-> Map (NonEmpty Text) (Expr s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Expr s a) -> (NonEmpty Text, Expr s a))
-> [(Text, Expr s a)] -> [(NonEmpty Text, Expr s a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Expr s a) -> (NonEmpty Text, Expr s a)
forall s a. (Text, Expr s a) -> (NonEmpty Text, Expr s a)
adapt ([(Text, Expr s a)] -> [(NonEmpty Text, Expr s a)])
-> (Map Text (Expr s a) -> [(Text, Expr s a)])
-> Map Text (Expr s a)
-> [(NonEmpty Text, Expr s a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text (Expr s a) -> [(Text, Expr s a)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList
  where
    adapt :: (Text, Expr s a) -> (NonEmpty Text, Expr s a)
    adapt :: (Text, Expr s a) -> (NonEmpty Text, Expr s a)
adapt (Text
key, Expr s a
expression) =
        case Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
shallowDenote Expr s a
expression of
            RecordLit Map Text (Expr s a)
m ->
                case ((Text, Expr s a) -> (NonEmpty Text, Expr s a))
-> [(Text, Expr s a)] -> [(NonEmpty Text, Expr s a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Expr s a) -> (NonEmpty Text, Expr s a)
forall s a. (Text, Expr s a) -> (NonEmpty Text, Expr s a)
adapt (Map Text (Expr s a) -> [(Text, Expr s a)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (Expr s a)
m) of
                    [ (NonEmpty Text
keys, Expr s a
expression') ] ->
                        (Text -> NonEmpty Text -> NonEmpty Text
forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.cons Text
key NonEmpty Text
keys, Expr s a
expression')
                    [(NonEmpty Text, Expr s a)]
_ ->
                        (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
key, Map Text (Expr s a) -> Expr s a
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit Map Text (Expr s a)
m)
            Expr s a
_ ->
                (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
key, Expr s a
expression)

-- | Escape a `Text` literal using Dhall's escaping rules for single-quoted
--   @Text@
escapeSingleQuotedText :: Text -> Text
escapeSingleQuotedText :: Text -> Text
escapeSingleQuotedText Text
inputText = Text
outputText
  where
    outputText :: Text
outputText = Text -> Text -> Text -> Text
substitute Text
"${" Text
"''${" (Text -> Text -> Text -> Text
substitute Text
"''" Text
"'''" Text
inputText)

    substitute :: Text -> Text -> Text -> Text
substitute Text
before Text
after = Text -> [Text] -> Text
Text.intercalate Text
after ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn Text
before

{-| Escape a `Text` literal using Dhall's escaping rules

    Note that the result does not include surrounding quotes
-}
escapeText_ :: Text -> Text
escapeText_ :: Text -> Text
escapeText_ Text
text = (Char -> Text) -> Text -> Text
Text.concatMap Char -> Text
adapt Text
text
  where
    adapt :: Char -> Text
adapt Char
c
        | Char
'\x20' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x21'     = Char -> Text
Text.singleton Char
c
        -- '\x22' == '"'
        | Char
'\x23' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c                    = Char -> Text
Text.singleton Char
c
        -- '\x24' == '$'
        | Char
'\x25' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x5B'     = Char -> Text
Text.singleton Char
c
        -- '\x5C' == '\\'
        | Char
'\x5D' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x10FFFF' = Char -> Text
Text.singleton Char
c
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"'                       = Text
"\\\""
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$'                       = Text
"\\$"
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\'                      = Text
"\\\\"
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\b'                      = Text
"\\b"
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\f'                      = Text
"\\f"
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'                      = Text
"\\n"
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r'                      = Text
"\\r"
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'                      = Text
"\\t"
        | Bool
otherwise                      = Text
"\\u" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
showDigits (Char -> Int
Data.Char.ord Char
c)

    showDigits :: Int -> Text
showDigits Int
r0 = String -> Text
Text.pack ((Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
showDigit [Int
q1, Int
q2, Int
q3, Int
r3])
      where
        (Int
q1, Int
r1) = Int
r0 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
4096
        (Int
q2, Int
r2) = Int
r1 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem`  Int
256
        (Int
q3, Int
r3) = Int
r2 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem`   Int
16

    showDigit :: Int -> Char
showDigit Int
n
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10    = Int -> Char
Data.Char.chr (Char -> Int
Data.Char.ord Char
'0' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
        | Bool
otherwise = Int -> Char
Data.Char.chr (Char -> Int
Data.Char.ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)

prettyToString :: Pretty a => a -> String
prettyToString :: a -> String
prettyToString =
    SimpleDocStream Any -> String
forall ann. SimpleDocStream ann -> String
Pretty.renderString (SimpleDocStream Any -> String)
-> (a -> SimpleDocStream Any) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> SimpleDocStream Any
forall ann. Doc ann -> SimpleDocStream ann
layout (Doc Any -> SimpleDocStream Any)
-> (a -> Doc Any) -> a -> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Any
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty

docToStrictText :: Doc ann -> Text.Text
docToStrictText :: Doc ann -> Text
docToStrictText = SimpleDocStream ann -> Text
forall ann. SimpleDocStream ann -> Text
Pretty.renderStrict (SimpleDocStream ann -> Text)
-> (Doc ann -> SimpleDocStream ann) -> Doc ann -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> SimpleDocStream ann
forall ann. Doc ann -> SimpleDocStream ann
layout

prettyToStrictText :: Pretty a => a -> Text.Text
prettyToStrictText :: a -> Text
prettyToStrictText = Doc Any -> Text
forall ann. Doc ann -> Text
docToStrictText (Doc Any -> Text) -> (a -> Doc Any) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Any
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty

-- | Layout using 'layoutOpts'
--
-- Tries hard to fit the document into 80 columns.
--
-- This also removes trailing space characters (@' '@) /unless/
-- they are enclosed in an annotation.
layout :: Pretty.Doc ann -> Pretty.SimpleDocStream ann
layout :: Doc ann -> SimpleDocStream ann
layout = SimpleDocStream ann -> SimpleDocStream ann
forall ann. SimpleDocStream ann -> SimpleDocStream ann
Pretty.removeTrailingWhitespace (SimpleDocStream ann -> SimpleDocStream ann)
-> (Doc ann -> SimpleDocStream ann)
-> Doc ann
-> SimpleDocStream ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
Pretty.layoutSmart LayoutOptions
layoutOpts

-- | Default layout options
layoutOpts :: Pretty.LayoutOptions
layoutOpts :: LayoutOptions
layoutOpts =
    LayoutOptions
Pretty.defaultLayoutOptions
        { layoutPageWidth :: PageWidth
Pretty.layoutPageWidth = Int -> Double -> PageWidth
Pretty.AvailablePerLine Int
80 Double
1.0 }

{- $setup
>>> import Test.QuickCheck (Fun(..))
-}