{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wall #-}
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.Text.Prettyprint.Doc.Render.Terminal as Terminal
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.Text as Pretty
import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
import qualified Dhall.Map as Map
import qualified Dhall.Set
data Ann
= Keyword
| Syntax
| Label
| Literal
| Builtin
| Operator
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
annToAnsiStyle :: Ann -> Terminal.AnsiStyle
annToAnsiStyle :: Ann -> AnsiStyle
annToAnsiStyle Keyword = AnsiStyle
Terminal.bold AnsiStyle -> AnsiStyle -> AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Color -> AnsiStyle
Terminal.colorDull Color
Terminal.Green
annToAnsiStyle Syntax = AnsiStyle
Terminal.bold AnsiStyle -> AnsiStyle -> AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Color -> AnsiStyle
Terminal.colorDull Color
Terminal.Green
annToAnsiStyle Label = AnsiStyle
forall a. Monoid a => a
mempty
annToAnsiStyle Literal = Color -> AnsiStyle
Terminal.colorDull Color
Terminal.Magenta
annToAnsiStyle Builtin = AnsiStyle
Terminal.underlined
annToAnsiStyle Operator = AnsiStyle
Terminal.bold AnsiStyle -> AnsiStyle -> AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Color -> AnsiStyle
Terminal.colorDull Color
Terminal.Green
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
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
duplicate :: a -> (a, a)
duplicate :: a -> (a, a)
duplicate x :: a
x = (a
x, a
x)
isWhitespace :: Char -> Bool
isWhitespace :: Char -> Bool
isWhitespace c :: Char
c =
case Char
c of
' ' -> Bool
True
'\n' -> Bool
True
'\t' -> Bool
True
'\r' -> Bool
True
_ -> Bool
False
renderSrc
:: (Text -> Text)
-> Maybe Src
-> Doc Ann
renderSrc :: (Text -> Text) -> Maybe Src -> Doc Ann
renderSrc strip :: Text -> Text
strip (Just (Src {..}))
| 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 c :: Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\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
== '\n' then Doc Ann
forall a. Monoid a => a
mempty else " "
oldLines :: [Text]
oldLines = Text -> Text -> [Text]
Text.splitOn "\n" Text
strippedText
spacePrefix :: Text -> Text
spacePrefix = (Char -> Bool) -> Text -> Text
Text.takeWhile Char -> Bool
horizontalSpace
commonPrefix :: Text -> Text -> Text
commonPrefix a :: Text
a b :: Text
b = case Text -> Text -> Maybe (Text, Text, Text)
Text.commonPrefixes Text
a Text
b of
Nothing -> ""
Just (c :: Text
c, _, _) -> Text
c
sharedSpacePrefix :: [Text] -> Text
sharedSpacePrefix [] = ""
sharedSpacePrefix (l :: Text
l : ls :: [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
[] ->
[]
l0 :: Text
l0 : ls :: [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 l :: Text
l =
case Text -> Text -> Maybe Text
Text.stripPrefix Text
sharedPrefix Text
l of
Nothing -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
l
Just l' :: 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 x :: Doc ann
x y :: 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 _ _ =
Doc Ann
forall a. Monoid a => a
mempty
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 "$"
colon :: Doc Ann
colon = Doc Ann -> Doc Ann
syntax ":"
equals :: Doc Ann
equals = Doc Ann -> Doc Ann
syntax "="
dot :: Doc Ann
dot = Doc Ann -> Doc Ann
syntax "."
lambda :: CharacterSet -> Doc Ann
lambda :: CharacterSet -> Doc Ann
lambda Unicode = Doc Ann -> Doc Ann
syntax "λ"
lambda ASCII = Doc Ann -> Doc Ann
syntax "\\"
forall :: CharacterSet -> Doc Ann
forall :: CharacterSet -> Doc Ann
forall Unicode = Doc Ann -> Doc Ann
syntax "∀"
forall ASCII = Doc Ann -> Doc Ann
syntax "forall "
rarrow :: CharacterSet -> Doc Ann
rarrow :: CharacterSet -> Doc Ann
rarrow Unicode = Doc Ann -> Doc Ann
syntax "→"
rarrow ASCII = Doc Ann -> Doc Ann
syntax "->"
doubleColon :: Doc Ann
doubleColon :: Doc Ann
doubleColon = Doc Ann -> Doc Ann
syntax "::"
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 docs :: [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)
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 docs :: [(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
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 docs :: [(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 _ [] =
Doc Ann
lbrace Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
rbrace
hangingBraces n :: Int
n docs :: [(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 x :: Doc ann
x y :: 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 (x0 :: a
x0 : xs0 :: [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 diffXs :: [t] -> c
diffXs x :: t
x [] = ([t] -> c
diffXs [], t
x)
go diffXs :: [t] -> c
diffXs x :: t
x (y :: t
y : ys :: [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
arrows :: CharacterSet -> [ Doc Ann ] -> Doc Ann
arrows :: CharacterSet -> [Doc Ann] -> Doc Ann
arrows characterSet :: CharacterSet
characterSet docs :: [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
Nothing -> [Doc Ann]
docs
Just (init_ :: [Doc Ann]
init_, last_ :: 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 :: 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 ASCII = "/\\"
combine Unicode = "∧"
combineTypes :: CharacterSet -> Text
combineTypes :: CharacterSet -> Text
combineTypes ASCII = "//\\\\"
combineTypes Unicode = "⩓"
prefer :: CharacterSet -> Text
prefer :: CharacterSet -> Text
prefer ASCII = "//"
prefer Unicode = "⫽"
equivalent :: CharacterSet -> Text
equivalent :: CharacterSet -> Text
equivalent ASCII = "==="
equivalent Unicode = "≡"
enclose
:: Doc ann
-> Doc 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, Doc ann)]
-> Doc ann
enclose beginShort :: Doc ann
beginShort _ _ _ endShort :: Doc ann
endShort _ [] =
Doc ann
beginShort Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
endShort
where
enclose beginShort :: Doc ann
beginShort beginLong :: Doc ann
beginLong sepShort :: Doc ann
sepShort sepLong :: Doc ann
sepLong endShort :: Doc ann
endShort endLong :: Doc ann
endLong docs :: [(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 x :: Doc ann
x y :: 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 x :: a
x y :: a
y = a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y
enclose'
:: 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
enclose' beginShort :: Doc ann
beginShort beginLong :: Doc ann
beginLong sepShort :: Doc ann
sepShort sepLong :: Doc ann
sepLong docs :: [(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 c :: Char
c = ('\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
<= '\x5A') Bool -> Bool -> Bool
|| ('\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
<= '\x7A')
digit :: Char -> Bool
digit :: Char -> Bool
digit c :: Char
c = '\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
<= '\x39'
alphaNum :: Char -> Bool
alphaNum :: Char -> Bool
alphaNum c :: Char
c = Char -> Bool
alpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
digit Char
c
headCharacter :: Char -> Bool
headCharacter :: Char -> Bool
headCharacter c :: Char
c = Char -> Bool
alpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_'
tailCharacter :: Char -> Bool
tailCharacter :: Char -> Bool
tailCharacter c :: Char
c = Char -> Bool
alphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/'
escapeLabel :: Bool -> Text -> Text
escapeLabel :: Bool -> Text -> Text
escapeLabel allowReserved :: Bool
allowReserved l :: Text
l =
case Text -> Maybe (Char, Text)
Text.uncons Text
l of
Just (h :: Char
h, t :: 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
allowReserved 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
reservedIdentifiers))
-> Text
l
_ -> "`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "`"
prettyLabelShared :: Bool -> Text -> Doc Ann
prettyLabelShared :: Bool -> Text -> Doc Ann
prettyLabelShared b :: Bool
b l :: 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 a :: 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 Type = Doc Ann -> Doc Ann
builtin "Type"
prettyConst Kind = Doc Ann -> Doc Ann
builtin "Kind"
prettyConst Sort = Doc Ann -> Doc Ann
builtin "Sort"
prettyVar :: Var -> Doc Ann
prettyVar :: Var -> Doc Ann
prettyVar (V x :: Text
x 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 x :: Text
x n :: 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
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Ann
prettyInt Int
n))
prettyEnvironmentVariable :: Text -> Doc ann
prettyEnvironmentVariable :: Text -> Doc ann
prettyEnvironmentVariable t :: 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{..} (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{..} (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{..} (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 _ = Maybe (Doc Ann)
forall a. Maybe a
Nothing
escapeEnvironmentVariable :: Text -> Text
escapeEnvironmentVariable :: Text -> Text
escapeEnvironmentVariable t :: Text
t
| Text -> Bool
validBashEnvVar Text
t = Text
t
| Bool
otherwise = "\"" 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
<> "\""
where
validBashEnvVar :: Text -> Bool
validBashEnvVar v :: Text
v = case Text -> Maybe (Char, Text)
Text.uncons Text
v of
Nothing -> Bool
False
Just (c :: Char
c, v' :: Text
v') ->
(Char -> Bool
alpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_')
Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
Text.all (\c' :: Char
c' -> Char -> Bool
alphaNum Char
c' Bool -> Bool -> Bool
|| Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_') Text
v'
prettyCharacterSet :: Pretty a => CharacterSet -> Expr Src a -> Doc Ann
prettyCharacterSet :: CharacterSet -> Expr Src a -> Doc Ann
prettyCharacterSet characterSet :: CharacterSet
characterSet expression :: 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 _ _ _) =
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 a :: Text
a b :: Expr Src a
b c :: 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 c :: Expr Src a
c
| Just doc :: 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 _ d :: 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 _ _ _) =
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]
forall a. a -> [a] -> [a]
: [Doc Ann] -> [Doc Ann]
forall a. [a] -> [a]
cycle
[ Doc Ann -> Doc Ann
keyword "then" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> " "
, Doc Ann -> Doc Ann
keyword "else" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> " "
]
prefixesShort :: [Doc Ann]
prefixesShort =
""
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 "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 "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 initial :: Bool
initial (BoolIf a :: Expr Src a
a b :: Expr Src a
b c :: 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 = " "
| Bool
otherwise = Doc Ann
forall a. Monoid a => a
mempty
docLong :: [Doc Ann]
docLong =
[ Doc Ann -> Doc Ann
keyword "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
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 initial :: Bool
initial c :: Expr Src a
c
| Just doc :: 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 _ d :: 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 a :: Expr Src a
a b :: Expr Src a
b c :: 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 "if" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> " " 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 c :: Expr Src a
c
| Just doc :: 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 _ d :: 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 a0 :: Binding Src a
a0 b0 :: 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
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 as :: NonEmpty (Binding Src a)
as b :: 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 (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\t')
stripNewline :: Text -> Text
stripNewline t :: Text
t =
case Text -> Maybe (Char, Text)
Text.uncons Text
t' of
Just ('\n', t'' :: Text
t'') -> Text -> Text
stripSpaces Text
t''
_ -> Text
t'
where t' :: Text
t' = Text -> Text
stripSpaces Text
t
docA :: Binding Src a -> Doc Ann
docA (Binding src0 :: Maybe Src
src0 c :: Text
c src1 :: Maybe Src
src1 Nothing src2 :: Maybe Src
src2 e :: 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 "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
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 "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 src0 :: Maybe Src
src0 c :: Text
c src1 :: Maybe Src
src1 (Just (src3 :: Maybe Src
src3, d :: Expr Src a
d)) src2 :: Maybe Src
src2 e :: Expr Src a
e) =
Doc Ann -> Doc Ann
keyword "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 "in" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> " " 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 "in" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> " " 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 _ _ _) =
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 "_" b :: Expr Src a
b c :: 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 a :: Text
a b :: Expr Src a
b c :: 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 c :: Expr Src a
c
| Just doc :: 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 _ d :: 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 a :: Expr Src a
a b :: NonEmpty Text
b c :: 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
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> Doc Ann
keyword "with" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> " " 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
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align (Doc Ann -> Doc Ann
keyword "with" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> " " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
update)
(update :: Doc Ann
update, _) =
(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 a :: 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 "assert" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> " " 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
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
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> Doc Ann
keyword "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
forall a. Semigroup a => a -> a -> a
<> Expr Src a -> Doc Ann
prettyExpression Expr Src a
a
)
prettyExpression a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a b :: Expr Src a
b (Just c :: 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 "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 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 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 "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
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 a :: Expr Src a
a (Just b :: 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 "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 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 "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 _ _) =
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 a. Semigroup a => a -> a -> a
<> Doc Ann
colon 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))
-> [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 a :: Expr Src a
a b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a) b :: 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
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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 op :: Text
op docs :: [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
prefix
(" " 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
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
== 1 then " " else " "
spacer :: Doc Ann
spacer = if Text -> Int
Text.length Text
op Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then " " else " "
prettyEquivalentExpression :: Pretty a => Expr Src a -> Doc Ann
prettyEquivalentExpression :: Expr Src a -> Doc Ann
prettyEquivalentExpression a0 :: Expr Src a
a0@(Equivalent _ _) =
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 a :: Expr Src a
a b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 _ _) =
Text -> [Doc Ann] -> Doc Ann
prettyOperator "?" (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 a :: Expr Src a
a b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 _ _) =
Text -> [Doc Ann] -> Doc Ann
prettyOperator "||" (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 a :: Expr Src a
a b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 _ _) =
Text -> [Doc Ann] -> Doc Ann
prettyOperator "+" (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 a :: Expr Src a
a b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 _ _) =
Text -> [Doc Ann] -> Doc Ann
prettyOperator "++" (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 a :: Expr Src a
a b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 _ _) =
Text -> [Doc Ann] -> Doc Ann
prettyOperator "#" (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 a :: Expr Src a
a b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 _ _) =
Text -> [Doc Ann] -> Doc Ann
prettyOperator "&&" (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 a :: Expr Src a
a b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 _ _ _) =
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 _ a :: Expr Src a
a b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 _ a :: Expr Src a
a b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 _ _) =
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 a :: Expr Src a
a b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 _ _) =
Text -> [Doc Ann] -> Doc Ann
prettyOperator "*" (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 a :: Expr Src a
a b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 _ _) =
Text -> [Doc Ann] -> Doc Ann
prettyOperator "==" (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 a :: Expr Src a
a b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 _ _) =
Text -> [Doc Ann] -> Doc Ann
prettyOperator "!=" (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 a :: Expr Src a
a b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 args :: [Expr Src a]
args = \case
App a :: Expr Src a
a b :: 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 a :: 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 "Some") (Expr Src a
a Expr Src a -> [Expr Src a] -> [Expr Src a]
forall a. a -> [a] -> [a]
: [Expr Src a]
args)
Merge a :: Expr Src a
a b :: Expr Src a
b 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 "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 a :: Expr Src a
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 "toMap") (Expr Src a
a Expr Src a -> [Expr Src a] -> [Expr Src a]
forall a. a -> [a] -> [a]
: [Expr Src a]
args)
e :: Expr Src a
e | Note _ b :: 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 doc :: 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 f :: Doc Ann
f args :: [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)
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 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) =
a -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty a
a
prettyImportExpression a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a b :: 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 kvs :: 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 0 Map Text (Expr Src a)
kvs
)
_ -> 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Expr Src a
a b :: 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 a :: Expr Src a
a (Left b :: 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 a :: Expr Src a
a (Right b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 a :: Var
a) =
Var -> Doc Ann
prettyVar Var
a
prettyPrimitiveExpression (Const k :: Const
k) =
Const -> Doc Ann
prettyConst Const
k
prettyPrimitiveExpression Bool =
Doc Ann -> Doc Ann
builtin "Bool"
prettyPrimitiveExpression Natural =
Doc Ann -> Doc Ann
builtin "Natural"
prettyPrimitiveExpression NaturalFold =
Doc Ann -> Doc Ann
builtin "Natural/fold"
prettyPrimitiveExpression NaturalBuild =
Doc Ann -> Doc Ann
builtin "Natural/build"
prettyPrimitiveExpression NaturalIsZero =
Doc Ann -> Doc Ann
builtin "Natural/isZero"
prettyPrimitiveExpression NaturalEven =
Doc Ann -> Doc Ann
builtin "Natural/even"
prettyPrimitiveExpression NaturalOdd =
Doc Ann -> Doc Ann
builtin "Natural/odd"
prettyPrimitiveExpression NaturalToInteger =
Doc Ann -> Doc Ann
builtin "Natural/toInteger"
prettyPrimitiveExpression NaturalShow =
Doc Ann -> Doc Ann
builtin "Natural/show"
prettyPrimitiveExpression NaturalSubtract =
Doc Ann -> Doc Ann
builtin "Natural/subtract"
prettyPrimitiveExpression Integer =
Doc Ann -> Doc Ann
builtin "Integer"
prettyPrimitiveExpression IntegerClamp =
Doc Ann -> Doc Ann
builtin "Integer/clamp"
prettyPrimitiveExpression IntegerNegate =
Doc Ann -> Doc Ann
builtin "Integer/negate"
prettyPrimitiveExpression IntegerShow =
Doc Ann -> Doc Ann
builtin "Integer/show"
prettyPrimitiveExpression IntegerToDouble =
Doc Ann -> Doc Ann
builtin "Integer/toDouble"
prettyPrimitiveExpression Double =
Doc Ann -> Doc Ann
builtin "Double"
prettyPrimitiveExpression DoubleShow =
Doc Ann -> Doc Ann
builtin "Double/show"
prettyPrimitiveExpression Text =
Doc Ann -> Doc Ann
builtin "Text"
prettyPrimitiveExpression TextShow =
Doc Ann -> Doc Ann
builtin "Text/show"
prettyPrimitiveExpression List =
Doc Ann -> Doc Ann
builtin "List"
prettyPrimitiveExpression ListBuild =
Doc Ann -> Doc Ann
builtin "List/build"
prettyPrimitiveExpression ListFold =
Doc Ann -> Doc Ann
builtin "List/fold"
prettyPrimitiveExpression ListLength =
Doc Ann -> Doc Ann
builtin "List/length"
prettyPrimitiveExpression ListHead =
Doc Ann -> Doc Ann
builtin "List/head"
prettyPrimitiveExpression ListLast =
Doc Ann -> Doc Ann
builtin "List/last"
prettyPrimitiveExpression ListIndexed =
Doc Ann -> Doc Ann
builtin "List/indexed"
prettyPrimitiveExpression ListReverse =
Doc Ann -> Doc Ann
builtin "List/reverse"
prettyPrimitiveExpression Optional =
Doc Ann -> Doc Ann
builtin "Optional"
prettyPrimitiveExpression None =
Doc Ann -> Doc Ann
builtin "None"
prettyPrimitiveExpression OptionalFold =
Doc Ann -> Doc Ann
builtin "Optional/fold"
prettyPrimitiveExpression OptionalBuild =
Doc Ann -> Doc Ann
builtin "Optional/build"
prettyPrimitiveExpression (BoolLit True) =
Doc Ann -> Doc Ann
builtin "True"
prettyPrimitiveExpression (BoolLit False) =
Doc Ann -> Doc Ann
builtin "False"
prettyPrimitiveExpression (IntegerLit a :: Integer
a)
| 0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
a = Doc Ann -> Doc Ann
literal "+" 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 a :: Natural
a) =
Natural -> Doc Ann
prettyNatural Natural
a
prettyPrimitiveExpression (DoubleLit (DhallDouble a :: Double
a)) =
Double -> Doc Ann
prettyDouble Double
a
prettyPrimitiveExpression (TextLit a :: 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 a :: 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 a :: 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 a :: 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 Nothing b :: 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 a :: Expr Src a
a
| Just doc :: 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 _ b :: 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 prettyKey :: k -> Doc Ann
prettyKey prettyValue :: Expr Src a -> Doc Ann
prettyValue separator :: Doc Ann
separator (key :: k
key, val :: 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 _T :: Expr Src a
_T r :: Expr Src a
r =
" "
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 kvs :: 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 2 Map Text (Expr Src a)
kvs
_ ->
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
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
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
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 val' :: Expr Src a
val' ->
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> Doc Ann
builtin "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 _T :: Expr Src a
_T r :: 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 _ ->
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
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 _ xs :: 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
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'
_ -> 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
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 val' :: Expr Src a
val' Nothing ->
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> Doc Ann
keyword "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 _T :: Expr Src a
_T r :: 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
_ -> 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
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 _T :: Expr Src a
_T r :: 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 _ ->
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
forall a. Semigroup a => a -> a -> a
<> Expr Src a -> Doc Ann
prettyValue Expr Src a
val
ListLit _ xs :: 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
forall a. Semigroup a => a -> a -> a
<> Expr Src a -> Doc Ann
prettyValue Expr Src a
val
_ ->
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
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 braceStyle :: [(Doc Ann, Doc Ann)] -> Doc Ann
braceStyle a :: 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 (keys :: NonEmpty Text
keys, value :: Expr Src a
value) =
case NonEmpty Text
keys of
key :: Text
key :| []
| Var (V key' :: Text
key' 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 -> 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 (key :: Text
key, Just val :: 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 (key :: Text
key, 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 a :: [(Text, Expr Src a)]
a b :: Text
b)
| (Char -> Bool) -> Bool
anyText (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\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
/= '\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
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 "''"
)
where
Chunks a' :: [(Text, Expr Src a)]
a' b' :: 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
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
<> "\"")
anyText :: (Char -> Bool) -> Bool
anyText predicate :: 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
text, _) -> (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 (c :: Text
c, d :: 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
text = [Doc Ann] -> Doc Ann
forall a. Monoid a => [a] -> a
mconcat [Doc Ann]
docs
where
lines_ :: [Text]
lines_ = Text -> Text -> [Text]
Text.splitOn "\n" (Text -> Text
escapeSingleQuotedText Text
text)
prettyLine :: Text -> Doc Ann
prettyLine line :: 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 (c :: Text
c, d :: 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
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 t :: 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))
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
escapeSharedWhitespacePrefix :: Chunks s a -> Chunks s a
escapeSharedWhitespacePrefix :: Chunks s a -> Chunks s a
escapeSharedWhitespacePrefix literal_ :: 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 [] prefix₀ :: 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 [ ("", 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 ((prefix₀ :: Text
prefix₀, y :: Expr s a
y) : xys :: [(Text, Expr s a)]
xys) z :: 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 (("", 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 line :: 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₀
escapeControlCharacters :: Chunks s a -> Chunks s a
escapeControlCharacters :: Chunks s a -> Chunks s a
escapeControlCharacters (Chunks as0 :: [(Text, Expr s a)]
as0 b0 :: 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
(bs :: [(Text, Text)]
bs, b1 :: 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 (t0 :: Text
t0, e :: Expr s a
e) chunks :: [(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
(ts1 :: [(Text, Text)]
ts1, t1 :: Text
t1) = (Char -> Bool) -> Text -> ([(Text, Text)], Text)
splitOnPredicate Char -> Bool
predicate Text
t0
predicate :: Char -> Bool
predicate c :: Char
c = Char -> Bool
Data.Char.isControl Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ' ' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\t' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n'
toChunk :: (a, Text) -> (a, Expr s a)
toChunk (t0 :: a
t0, t1 :: 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))
splitOnPredicate :: (Char -> Bool) -> Text -> ([(Text, Text)], Text)
splitOnPredicate :: (Char -> Bool) -> Text -> ([(Text, Text)], Text)
splitOnPredicate p :: Char -> Bool
p t :: Text
t = case (Char -> Bool) -> Text -> (Text, Text)
Text.break Char -> Bool
p Text
t of
(a :: Text
a, "") -> ([], Text
a)
(a :: Text
a, b :: Text
b) -> case (Char -> Bool) -> Text -> (Text, Text)
Text.span Char -> Bool
p Text
b of
(c :: Text
c, d :: Text
d) -> case (Char -> Bool) -> Text -> ([(Text, Text)], Text)
splitOnPredicate Char -> Bool
p Text
d of
(e :: [(Text, Text)]
e, f :: Text
f) -> ((Text
a, Text
c) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
e, Text
f)
escapeTrailingSingleQuote :: Chunks s a -> Chunks s a
escapeTrailingSingleQuote :: Chunks s a -> Chunks s a
escapeTrailingSingleQuote chunks :: Chunks s a
chunks@(Chunks as :: [(Text, Expr s a)]
as b :: Text
b) =
case Text -> Maybe (Text, Char)
Text.unsnoc Text
b of
Just (b' :: Text
b', '\'') -> [(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 [] "'"))]) ""
_ -> Chunks s a
chunks
pretty_ :: Pretty a => a -> Text
pretty_ :: a -> Text
pretty_ = a -> Text
forall a. Pretty a => a -> Text
prettyToStrictText
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 (key :: Text
key, expression :: 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 m :: 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
[ (keys :: NonEmpty Text
keys, expression' :: 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')
_ ->
(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)
_ ->
(Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
key, Expr s a
expression)
escapeSingleQuotedText :: Text -> Text
escapeSingleQuotedText :: Text -> Text
escapeSingleQuotedText inputText :: Text
inputText = Text
outputText
where
outputText :: Text
outputText = Text -> Text -> Text -> Text
substitute "${" "''${" (Text -> Text -> Text -> Text
substitute "''" "'''" Text
inputText)
substitute :: Text -> Text -> Text -> Text
substitute before :: Text
before after :: 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
escapeText_ :: Text -> Text
escapeText_ :: Text -> Text
escapeText_ text :: Text
text = (Char -> Text) -> Text -> Text
Text.concatMap Char -> Text
adapt Text
text
where
adapt :: Char -> Text
adapt c :: Char
c
| '\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
<= '\x21' = Char -> Text
Text.singleton Char
c
| '\x23' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c = Char -> Text
Text.singleton Char
c
| '\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
<= '\x5B' = Char -> Text
Text.singleton Char
c
| '\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
<= '\x10FFFF' = Char -> Text
Text.singleton Char
c
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '"' = "\\\""
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '$' = "\\$"
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\\' = "\\\\"
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\b' = "\\b"
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\f' = "\\f"
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' = "\\n"
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\r' = "\\r"
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\t' = "\\t"
| Bool
otherwise = "\\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 r0 :: 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
(q1 :: Int
q1, r1 :: Int
r1) = Int
r0 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 4096
(q2 :: Int
q2, r2 :: Int
r2) = Int
r1 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 256
(q3 :: Int
q3, r3 :: Int
r3) = Int
r2 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 16
showDigit :: Int -> Char
showDigit n :: Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 10 = Int -> Char
Data.Char.chr (Char -> Int
Data.Char.ord '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 'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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 :: 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
layoutOpts :: Pretty.LayoutOptions
layoutOpts :: LayoutOptions
layoutOpts =
LayoutOptions
Pretty.defaultLayoutOptions
{ layoutPageWidth :: PageWidth
Pretty.layoutPageWidth = Int -> Double -> PageWidth
Pretty.AvailablePerLine 80 1.0 }