{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DeriveLift         #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE ViewPatterns       #-}

{-# OPTIONS_GHC -Wall #-}

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

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

    , CharacterSet(..)
    , detectCharacterSet
    , prettyCharacterSet
    , prettyImportExpression

    , prettyVar
    , pretty_
    , escapeText_
    , escapeEnvironmentVariable
    , prettyEnvironmentVariable

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

    , docToStrictText

    , builtin
    , keyword
    , literal
    , operator

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

    , temporalToText
    ) where

import                Control.DeepSeq               (NFData)
import                Data.Aeson
    ( FromJSON (..)
    , Value (String)
    )
import                Data.Aeson.Types              (typeMismatch, unexpected)
import                Data.ByteString               (ByteString)
import                Data.Data                     (Data)
import                Data.Foldable
import                Data.List.NonEmpty            (NonEmpty (..))
import                Data.Text                     (Text)
import                Dhall.Map                     (Map)
import                Dhall.Optics                  (cosmosOf, foldOf, to)
import                Dhall.Src                     (Src (..))
import                Dhall.Syntax
import {-# SOURCE #-} Dhall.Syntax.Instances.Pretty ()
import                GHC.Generics                  (Generic)
import                Language.Haskell.TH.Syntax    (Lift)
import                Numeric.Natural               (Natural)
import                Prettyprinter                 (Doc, Pretty, space)

import qualified Control.Exception             as Exception
import qualified Data.ByteString.Base16        as Base16
import qualified Data.Char
import qualified Data.HashSet
import qualified Data.List                     as List
import qualified Data.List.NonEmpty            as NonEmpty
import qualified Data.Maybe
import qualified Data.Text                     as Text
import qualified Data.Text.Encoding            as Encoding
import qualified Data.Time                     as Time
import qualified Dhall.Map                     as Map
import qualified Dhall.Syntax.Operations       as Operations
import qualified Prettyprinter                 as Pretty
import qualified Prettyprinter.Render.String   as Pretty
import qualified Prettyprinter.Render.Terminal as Terminal
import qualified Prettyprinter.Render.Text     as Pretty
import qualified Text.Printf                   as Printf

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

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

-- | This type determines whether to render code as `ASCII` or `Unicode`
data CharacterSet = ASCII | Unicode
    deriving (CharacterSet -> CharacterSet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CharacterSet -> CharacterSet -> Bool
$c/= :: CharacterSet -> CharacterSet -> Bool
== :: CharacterSet -> CharacterSet -> Bool
$c== :: CharacterSet -> CharacterSet -> Bool
Eq, Eq CharacterSet
CharacterSet -> CharacterSet -> Bool
CharacterSet -> CharacterSet -> Ordering
CharacterSet -> CharacterSet -> CharacterSet
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CharacterSet -> CharacterSet -> CharacterSet
$cmin :: CharacterSet -> CharacterSet -> CharacterSet
max :: CharacterSet -> CharacterSet -> CharacterSet
$cmax :: CharacterSet -> CharacterSet -> CharacterSet
>= :: CharacterSet -> CharacterSet -> Bool
$c>= :: CharacterSet -> CharacterSet -> Bool
> :: CharacterSet -> CharacterSet -> Bool
$c> :: CharacterSet -> CharacterSet -> Bool
<= :: CharacterSet -> CharacterSet -> Bool
$c<= :: CharacterSet -> CharacterSet -> Bool
< :: CharacterSet -> CharacterSet -> Bool
$c< :: CharacterSet -> CharacterSet -> Bool
compare :: CharacterSet -> CharacterSet -> Ordering
$ccompare :: CharacterSet -> CharacterSet -> Ordering
Ord, Int -> CharacterSet -> ShowS
[CharacterSet] -> ShowS
CharacterSet -> String
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, Typeable CharacterSet
CharacterSet -> DataType
CharacterSet -> Constr
(forall b. Data b => b -> b) -> CharacterSet -> CharacterSet
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CharacterSet -> u
forall u. (forall d. Data d => d -> u) -> CharacterSet -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CharacterSet -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CharacterSet -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CharacterSet -> m CharacterSet
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CharacterSet -> m CharacterSet
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CharacterSet
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CharacterSet -> c CharacterSet
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CharacterSet)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CharacterSet)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CharacterSet -> m CharacterSet
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CharacterSet -> m CharacterSet
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CharacterSet -> m CharacterSet
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CharacterSet -> m CharacterSet
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CharacterSet -> m CharacterSet
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CharacterSet -> m CharacterSet
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CharacterSet -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CharacterSet -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> CharacterSet -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CharacterSet -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CharacterSet -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CharacterSet -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CharacterSet -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CharacterSet -> r
gmapT :: (forall b. Data b => b -> b) -> CharacterSet -> CharacterSet
$cgmapT :: (forall b. Data b => b -> b) -> CharacterSet -> CharacterSet
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CharacterSet)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CharacterSet)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CharacterSet)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CharacterSet)
dataTypeOf :: CharacterSet -> DataType
$cdataTypeOf :: CharacterSet -> DataType
toConstr :: CharacterSet -> Constr
$ctoConstr :: CharacterSet -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CharacterSet
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CharacterSet
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CharacterSet -> c CharacterSet
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CharacterSet -> c CharacterSet
Data, forall x. Rep CharacterSet x -> CharacterSet
forall x. CharacterSet -> Rep CharacterSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CharacterSet x -> CharacterSet
$cfrom :: forall x. CharacterSet -> Rep CharacterSet x
Generic, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => CharacterSet -> m Exp
forall (m :: * -> *).
Quote m =>
CharacterSet -> Code m CharacterSet
liftTyped :: forall (m :: * -> *).
Quote m =>
CharacterSet -> Code m CharacterSet
$cliftTyped :: forall (m :: * -> *).
Quote m =>
CharacterSet -> Code m CharacterSet
lift :: forall (m :: * -> *). Quote m => CharacterSet -> m Exp
$clift :: forall (m :: * -> *). Quote m => CharacterSet -> m Exp
Lift, CharacterSet -> ()
forall a. (a -> ()) -> NFData a
rnf :: CharacterSet -> ()
$crnf :: CharacterSet -> ()
NFData)

-- | Since ASCII is a subset of Unicode, if either argument is Unicode, the
-- result is Unicode
instance Semigroup CharacterSet where
    CharacterSet
Unicode <> :: CharacterSet -> CharacterSet -> CharacterSet
<> CharacterSet
_ = CharacterSet
Unicode
    CharacterSet
_ <> CharacterSet
other = CharacterSet
other

instance Monoid CharacterSet where
    mempty :: CharacterSet
mempty = CharacterSet
ASCII

instance FromJSON CharacterSet where
  parseJSON :: Value -> Parser CharacterSet
parseJSON (String Text
"unicode") = forall (f :: * -> *) a. Applicative f => a -> f a
pure CharacterSet
Unicode
  parseJSON (String Text
"ascii") = forall (f :: * -> *) a. Applicative f => a -> f a
pure CharacterSet
ASCII
  parseJSON v :: Value
v@(String Text
_) = forall a. Value -> Parser a
unexpected Value
v
  parseJSON Value
v = forall a. String -> Value -> Parser a
typeMismatch String
"String" Value
v

-- | Detect which character set is used for the syntax of an expression
-- If any parts of the expression uses the Unicode syntax, the whole expression
-- is deemed to be using the Unicode syntax.
detectCharacterSet :: Expr Src a -> CharacterSet
detectCharacterSet :: forall a. Expr Src a -> CharacterSet
detectCharacterSet = forall a s. Getting a s a -> s -> a
foldOf (forall (f :: * -> *) a.
(Applicative f, Contravariant f) =>
LensLike' f a a -> LensLike' f a a
cosmosOf forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
subExpressions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall {s} {a}. Expr s a -> CharacterSet
exprToCharacterSet)
  where
    exprToCharacterSet :: Expr s a -> CharacterSet
exprToCharacterSet = \case
        Embed a
_ -> forall a. Monoid a => a
mempty -- Don't go down the embed route, otherwise: <<loop>>
        Lam (Just CharacterSet
Unicode) FunctionBinding s a
_ Expr s a
_ -> CharacterSet
Unicode
        Pi (Just CharacterSet
Unicode) Text
_ Expr s a
_ Expr s a
_ -> CharacterSet
Unicode
        Combine (Just CharacterSet
Unicode) Maybe Text
_ Expr s a
_ Expr s a
_ -> CharacterSet
Unicode
        CombineTypes (Just CharacterSet
Unicode) Expr s a
_ Expr s a
_ -> CharacterSet
Unicode
        Prefer (Just CharacterSet
Unicode) PreferAnnotation
_ Expr s a
_ Expr s a
_ -> CharacterSet
Unicode
        Equivalent (Just CharacterSet
Unicode) Expr s a
_ Expr s a
_ -> CharacterSet
Unicode
        Expr s a
_ -> forall a. Monoid a => a
mempty

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

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

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

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

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

    >>> let unusedSourcePos = Text.Megaparsec.SourcePos "" (Text.Megaparsec.mkPos 1) (Text.Megaparsec.mkPos 1)
    >>> let nonEmptySrc = Src unusedSourcePos unusedSourcePos "-- Documentation for x\n"
    >>> "let" <> " " <> renderSrc id (Just nonEmptySrc) <> "x = 1 in x"
    let -- Documentation for x
        x = 1 in x
    >>> let emptySrc = Src unusedSourcePos unusedSourcePos "      "
    >>> "let" <> " " <> renderSrc id (Just emptySrc) <> "x = 1 in x"
    let x = 1 in x
    >>> "let" <> " " <> renderSrc id Nothing <> "x = 1 in x"
    let x = 1 in x
-}
renderSrc
    :: (Text -> Text)
    -- ^ Used to preprocess the comment string (e.g. to strip whitespace)
    -> Maybe Src
    -- ^ Source span to render (if present)
    -> Doc Ann
renderSrc :: (Text -> Text) -> Maybe Src -> Doc Ann
renderSrc Text -> Text
strip (Just (Src {Text
SourcePos
srcText :: Src -> Text
srcEnd :: Src -> SourcePos
srcStart :: Src -> SourcePos
srcText :: Text
srcEnd :: SourcePos
srcStart :: SourcePos
..}))
    | Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isWhitespace Text
srcText) =
        Text -> Doc Ann
renderComment (Text -> Text
strip Text
srcText)
renderSrc Text -> Text
_ Maybe Src
_ =
    forall a. Monoid a => a
mempty

{-| Render a comment.

    Any preprocessing, such as whitespace stripping, needs to be handled by the
    caller, see e.g. 'renderSrc'.

    See the documentation for 'renderSrc' for examples.
-}
renderComment :: Text -> Doc Ann
renderComment :: Text -> Doc Ann
renderComment Text
text =
    forall ann. Doc ann -> Doc ann
Pretty.align (forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
Pretty.concatWith forall {ann}. Doc ann -> Doc ann -> Doc ann
f forall {ann}. [Doc ann]
newLines forall a. Semigroup a => a -> a -> a
<> Doc Ann
suffix)
  where
    horizontalSpace :: Char -> Bool
horizontalSpace Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t'

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

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

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

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

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

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

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

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

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

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

{-| This is a variant of 'renderSrc' with the following differences:

      * The 'srcText' is stripped of all whitespace at the start and the end.
      * When the stripped 'srcText' is empty, the result is 'Nothing'.
-}
renderSrcMaybe :: Maybe Src -> Maybe (Doc Ann)
renderSrcMaybe :: Maybe Src -> Maybe (Doc Ann)
renderSrcMaybe (Just Src{Text
SourcePos
srcText :: Text
srcEnd :: SourcePos
srcStart :: SourcePos
srcText :: Src -> Text
srcEnd :: Src -> SourcePos
srcStart :: Src -> SourcePos
..}) =
    case (Char -> Bool) -> Text -> Text
Text.dropAround Char -> Bool
isWhitespace Text
srcText of
        Text
"" -> forall a. Maybe a
Nothing
        Text
t  -> forall a. a -> Maybe a
Just (Text -> Doc Ann
renderComment Text
t)
renderSrcMaybe Maybe Src
_ = forall a. Maybe a
Nothing

{-| @
    'containsComment' mSrc ≡ 'Data.Maybe.isJust' ('renderSrcMaybe' mSrc)
    @
-}
containsComment :: Maybe Src -> Bool
containsComment :: Maybe Src -> Bool
containsComment Maybe Src
Nothing        = Bool
False
containsComment (Just Src{Text
SourcePos
srcText :: Text
srcEnd :: SourcePos
srcStart :: SourcePos
srcText :: Src -> Text
srcEnd :: Src -> SourcePos
srcStart :: Src -> SourcePos
..}) = Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isWhitespace Text
srcText)

-- Annotation helpers
keyword, syntax, label, literal, builtin, operator :: Doc Ann -> Doc Ann
keyword :: Doc Ann -> Doc Ann
keyword  = forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Keyword
syntax :: Doc Ann -> Doc Ann
syntax   = forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Syntax
label :: Doc Ann -> Doc Ann
label    = forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Label
literal :: Doc Ann -> Doc Ann
literal  = forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Literal
builtin :: Doc Ann -> Doc Ann
builtin  = forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Builtin
operator :: Doc Ann -> Doc Ann
operator = 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 forall ann. Doc ann
Pretty.comma
lbracket :: Doc Ann
lbracket = Doc Ann -> Doc Ann
syntax forall ann. Doc ann
Pretty.lbracket
rbracket :: Doc Ann
rbracket = Doc Ann -> Doc Ann
syntax forall ann. Doc ann
Pretty.rbracket
langle :: Doc Ann
langle   = Doc Ann -> Doc Ann
syntax forall ann. Doc ann
Pretty.langle
rangle :: Doc Ann
rangle   = Doc Ann -> Doc Ann
syntax forall ann. Doc ann
Pretty.rangle
lbrace :: Doc Ann
lbrace   = Doc Ann -> Doc Ann
syntax forall ann. Doc ann
Pretty.lbrace
rbrace :: Doc Ann
rbrace   = Doc Ann -> Doc Ann
syntax forall ann. Doc ann
Pretty.rbrace
lparen :: Doc Ann
lparen   = Doc Ann -> Doc Ann
syntax forall ann. Doc ann
Pretty.lparen
rparen :: Doc Ann
rparen   = Doc Ann -> Doc Ann
syntax forall ann. Doc ann
Pretty.rparen
pipe :: Doc Ann
pipe     = Doc Ann -> Doc Ann
syntax forall ann. Doc ann
Pretty.pipe
dollar :: Doc Ann
dollar   = Doc Ann -> Doc Ann
syntax Doc Ann
"$"
colon :: Doc Ann
colon    = Doc Ann -> Doc Ann
syntax Doc Ann
":"
equals :: Doc Ann
equals   = Doc Ann -> Doc Ann
syntax Doc Ann
"="
dot :: Doc Ann
dot      = Doc Ann -> Doc Ann
syntax Doc Ann
"."

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

prettyLabelShared :: Bool -> Text -> Doc Ann
prettyLabelShared :: Bool -> Text -> Doc Ann
prettyLabelShared Bool
b Text
l = Doc Ann -> Doc Ann
label (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

prettyKeys
    :: Foldable list
    => (key -> Doc Ann)
    -> list (Maybe Src, key, Maybe Src)
    -> Doc Ann
prettyKeys :: forall (list :: * -> *) key.
Foldable list =>
(key -> Doc Ann) -> list (Maybe Src, key, Maybe Src) -> Doc Ann
prettyKeys key -> Doc Ann
prettyK list (Maybe Src, key, Maybe Src)
keys = forall ann. Doc ann -> Doc ann
Pretty.group (forall {ann}. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short)
  where
    short :: Doc Ann
short = (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> [Doc ann] -> [Doc ann]
Pretty.punctuate Doc Ann
dot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Maybe Src, key, Maybe Src) -> Doc Ann
prettyKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) list (Maybe Src, key, Maybe Src)
keys

    long :: Doc Ann
long =
        case forall a b. (a -> b) -> [a] -> [b]
map (Maybe Src, key, Maybe Src) -> Doc Ann
prettyKey (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList list (Maybe Src, key, Maybe Src)
keys) of
            []       -> forall a. Monoid a => a
mempty
            [Doc Ann
doc]    -> Doc Ann
doc
            Doc Ann
doc:[Doc Ann]
docs ->
                  forall ann. Doc ann -> Doc ann
Pretty.align
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> [Doc ann] -> [Doc ann]
Pretty.punctuate (forall ann. Doc ann
Pretty.hardline forall a. Semigroup a => a -> a -> a
<> Doc Ann
". ")
                forall a b. (a -> b) -> a -> b
$ forall ann. Int -> Doc ann -> Doc ann
Pretty.indent Int
2 Doc Ann
doc forall a. a -> [a] -> [a]
: [Doc Ann]
docs

    prettyKey :: (Maybe Src, key, Maybe Src) -> Doc Ann
prettyKey (Maybe Src
mSrc0, key
key, Maybe Src
mSrc1) =
          forall ann. Doc ann -> Doc ann
Pretty.align
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> [Doc ann] -> [Doc ann]
Pretty.punctuate forall ann. Doc ann
Pretty.hardline
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
Data.Maybe.catMaybes
        forall a b. (a -> b) -> a -> b
$ [ Maybe Src -> Maybe (Doc Ann)
renderSrcMaybe Maybe Src
mSrc0
          , forall a. a -> Maybe a
Just (key -> Doc Ann
prettyK key
key)
          , Maybe Src -> Maybe (Doc Ann)
renderSrcMaybe Maybe Src
mSrc1
          ]

prettyLabels :: [Text] -> Doc Ann
prettyLabels :: [Text] -> Doc Ann
prettyLabels [Text]
a
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
a    = Doc Ann
lbrace forall a. Semigroup a => a -> a -> a
<> Doc Ann
rbrace
    | Bool
otherwise = [(Doc Ann, Doc Ann)] -> Doc Ann
braces (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> (a, a)
duplicate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Ann
prettyAnyLabel) [Text]
a)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

This means the structure of parsed let-blocks is preserved.
-}
prettyCharacterSet :: Pretty a => CharacterSet -> Expr Src a -> Doc Ann
prettyCharacterSet :: forall a. Pretty a => CharacterSet -> Expr Src a -> Doc Ann
prettyCharacterSet CharacterSet
characterSet = Expr Src a -> Doc Ann
prettyCompleteExpression
  where
    PrettyPrinters{Expr Src a -> Doc Ann
prettyImportExpression_ :: forall a. PrettyPrinters a -> Expr Src a -> Doc Ann
prettyCompleteExpression :: forall a. PrettyPrinters a -> Expr Src a -> Doc Ann
prettyImportExpression_ :: Expr Src a -> Doc Ann
prettyCompleteExpression :: Expr Src a -> Doc Ann
..} = forall a. Pretty a => CharacterSet -> PrettyPrinters a
prettyPrinters CharacterSet
characterSet

-- Mainly used by the `Pretty` instance for `Import`
prettyImportExpression :: Pretty a => Expr Src a -> Doc Ann
prettyImportExpression :: forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression = Expr Src a -> Doc Ann
prettyImportExpression_
  where
    PrettyPrinters{Expr Src a -> Doc Ann
prettyCompleteExpression :: Expr Src a -> Doc Ann
prettyImportExpression_ :: Expr Src a -> Doc Ann
prettyImportExpression_ :: forall a. PrettyPrinters a -> Expr Src a -> Doc Ann
prettyCompleteExpression :: forall a. PrettyPrinters a -> Expr Src a -> Doc Ann
..} = forall a. Pretty a => CharacterSet -> PrettyPrinters a
prettyPrinters CharacterSet
Unicode

data PrettyPrinters a = PrettyPrinters
    { forall a. PrettyPrinters a -> Expr Src a -> Doc Ann
prettyCompleteExpression :: Expr Src a -> Doc Ann
    , forall a. PrettyPrinters a -> Expr Src a -> Doc Ann
prettyImportExpression_  :: Expr Src a -> Doc Ann
    }

prettyPrinters :: Pretty a => CharacterSet -> PrettyPrinters a
prettyPrinters :: forall a. Pretty a => CharacterSet -> PrettyPrinters a
prettyPrinters CharacterSet
characterSet =
    PrettyPrinters{forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression_ :: forall a. Pretty a => Expr Src a -> Doc Ann
prettyCompleteExpression :: forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression_ :: Expr Src a -> Doc Ann
prettyCompleteExpression :: Expr Src a -> Doc Ann
..}
  where
    prettyCompleteExpression :: Expr Src a -> Doc Ann
prettyCompleteExpression Expr Src a
expression =
        forall ann. Doc ann -> Doc ann
Pretty.group (forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Expr Src a
expression)

    prettyExpression :: Expr Src a -> Doc Ann
prettyExpression a0 :: Expr Src a
a0@(Lam Maybe CharacterSet
_ FunctionBinding Src a
_ Expr Src a
_) =
        CharacterSet -> [Doc Ann] -> Doc Ann
arrows CharacterSet
characterSet (Expr Src a -> [Doc Ann]
docs Expr Src a
a0)
      where
        docs :: Expr Src a -> [Doc Ann]
docs (Lam Maybe CharacterSet
_ (FunctionBinding { functionBindingVariable :: forall s a. FunctionBinding s a -> Text
functionBindingVariable = Text
a, functionBindingAnnotation :: forall s a. FunctionBinding s a -> Expr s a
functionBindingAnnotation = Expr Src a
b }) Expr Src a
c) =
            forall ann. Doc ann -> Doc ann
Pretty.group (forall {ann}. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short) 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 forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space)
                forall a. Semigroup a => a -> a -> a
<>  forall ann. Doc ann -> Doc ann
Pretty.align
                    (   (Doc Ann
lparen forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space)
                    forall a. Semigroup a => a -> a -> a
<>  Text -> Doc Ann
prettyLabel Text
a
                    forall a. Semigroup a => a -> a -> a
<>  forall ann. Doc ann
Pretty.hardline
                    forall a. Semigroup a => a -> a -> a
<>  (Doc Ann
colon forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space)
                    forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyExpression Expr Src a
b
                    forall a. Semigroup a => a -> a -> a
<>  forall ann. Doc ann
Pretty.hardline
                    forall a. Semigroup a => a -> a -> a
<>  Doc Ann
rparen
                    )

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

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

        longLines :: [Doc Ann]
longLines = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 =
            forall ann. Doc ann -> Doc ann
Pretty.align (forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
List.intersperse forall ann. Doc ann
Pretty.hardline [Doc Ann]
longLines))

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

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

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

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

        isSpace :: Char -> Bool
isSpace Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t'
        stripSpaces :: Text -> Text
stripSpaces =
            (Char -> Bool) -> Text -> Text
Text.dropAround Char -> Bool
isSpace
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"\n"
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> Text -> Text
Text.dropWhileEnd Char -> Bool
isSpace)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn Text
"\n"

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

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

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

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

            short :: Doc Ann
short = CharacterSet -> Doc Ann
forall_ CharacterSet
characterSet forall a. Semigroup a => a -> a -> a
<> Doc Ann
lparen
                forall a. Semigroup a => a -> a -> a
<>  Text -> Doc Ann
prettyLabel Text
a
                forall a. Semigroup a => a -> a -> a
<>  forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> Doc Ann
colon forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space
                forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyExpression Expr Src a
b
                forall a. Semigroup a => a -> a -> a
<>  Doc Ann
rparen
        docs Expr Src a
c
            | Just Doc Ann
doc <- forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
c =
                [ Doc Ann
doc ]
            | Note Src
_ Expr Src a
d <- Expr Src a
c =
                Expr Src a -> [Doc Ann]
docs Expr Src a
d
            | Bool
otherwise =
                [ Expr Src a -> Doc Ann
prettyExpression Expr Src a
c ]
    prettyExpression (With (forall s a. Expr s a -> Expr s a
Dhall.Syntax.shallowDenote -> Expr Src a
a) NonEmpty WithComponent
b Expr Src a
c) =
            case Expr Src a
a of
                With{} ->
                    -- Don't parenthesize an inner with-expression
                    Expr Src a -> Doc Ann
prettyExpression Expr Src a
a
                Expr Src a
_ ->
                    forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression_ Expr Src a
a
        forall a. Semigroup a => a -> a -> a
<>  forall {ann}. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short
      where
        short :: Doc Ann
short = Doc Ann
" " forall a. Semigroup a => a -> a -> a
<> Doc Ann -> Doc Ann
keyword Doc Ann
"with" forall a. Semigroup a => a -> a -> a
<> Doc Ann
" " forall a. Semigroup a => a -> a -> a
<> Doc Ann
update

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

        (Doc Ann
update, Doc Ann
_) =
            forall a key.
Pretty a =>
(key -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> KeyValue key Src a
-> (Doc Ann, Doc Ann)
prettyKeyValue WithComponent -> Doc Ann
prettyKey forall a. Pretty a => Expr Src a -> Doc Ann
prettyOperatorExpression Doc Ann
equals
                (forall key s a. NonEmpty key -> Expr s a -> KeyValue key s a
makeKeyValue NonEmpty WithComponent
b Expr Src a
c)

        prettyKey :: WithComponent -> Doc Ann
prettyKey (WithLabel Text
text) = Text -> Doc Ann
prettyAnyLabel Text
text
        prettyKey  WithComponent
WithQuestion    = Doc Ann -> Doc Ann
syntax Doc Ann
"?"
    prettyExpression (Assert Expr Src a
a) =
        forall ann. Doc ann -> Doc ann
Pretty.group (forall {ann}. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short)
      where
        short :: Doc Ann
short = Doc Ann -> Doc Ann
keyword Doc Ann
"assert" forall a. Semigroup a => a -> a -> a
<> Doc Ann
" " forall a. Semigroup a => a -> a -> a
<> Doc Ann
colon forall a. Semigroup a => a -> a -> a
<> Doc Ann
" " forall a. Semigroup a => a -> a -> a
<> Expr Src a -> Doc Ann
prettyExpression Expr Src a
a

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    prettyPrimitiveExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyPrimitiveExpression :: forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression (Var Var
a) =
        Var -> Doc Ann
prettyVar Var
a
    prettyPrimitiveExpression (Const Const
k) =
        Const -> Doc Ann
prettyConst Const
k
    prettyPrimitiveExpression Expr Src a
Bool =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Bool"
    prettyPrimitiveExpression Expr Src a
Bytes =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Bytes"
    prettyPrimitiveExpression Expr Src a
Natural =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural"
    prettyPrimitiveExpression Expr Src a
NaturalFold =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/fold"
    prettyPrimitiveExpression Expr Src a
NaturalBuild =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/build"
    prettyPrimitiveExpression Expr Src a
NaturalIsZero =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/isZero"
    prettyPrimitiveExpression Expr Src a
NaturalEven =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/even"
    prettyPrimitiveExpression Expr Src a
NaturalOdd =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/odd"
    prettyPrimitiveExpression Expr Src a
NaturalToInteger =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/toInteger"
    prettyPrimitiveExpression Expr Src a
NaturalShow =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/show"
    prettyPrimitiveExpression Expr Src a
NaturalSubtract =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/subtract"
    prettyPrimitiveExpression Expr Src a
Integer =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Integer"
    prettyPrimitiveExpression Expr Src a
IntegerClamp =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Integer/clamp"
    prettyPrimitiveExpression Expr Src a
IntegerNegate =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Integer/negate"
    prettyPrimitiveExpression Expr Src a
IntegerShow =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Integer/show"
    prettyPrimitiveExpression Expr Src a
IntegerToDouble =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Integer/toDouble"
    prettyPrimitiveExpression Expr Src a
Double =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Double"
    prettyPrimitiveExpression Expr Src a
DoubleShow =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Double/show"
    prettyPrimitiveExpression Expr Src a
Text =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Text"
    prettyPrimitiveExpression Expr Src a
TextReplace =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Text/replace"
    prettyPrimitiveExpression Expr Src a
TextShow =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Text/show"
    prettyPrimitiveExpression Expr Src a
Date =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Date"
    prettyPrimitiveExpression (DateLiteral Day
day) =
        Doc Ann -> Doc Ann
literal
            (   forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (forall r. PrintfType r => String -> r
Printf.printf String
"%04d" Integer
_HHHH :: String)
            forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"-"
            forall a. Semigroup a => a -> a -> a
<>  forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (forall r. PrintfType r => String -> r
Printf.printf String
"%02d" Int
_MM :: String)
            forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"-"
            forall a. Semigroup a => a -> a -> a
<>  forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (forall r. PrintfType r => String -> r
Printf.printf String
"%02d" Int
_DD :: String)
            )
      where
        (Integer
_HHHH, Int
_MM, Int
_DD) = Day -> (Integer, Int, Int)
Time.toGregorian Day
day
    prettyPrimitiveExpression Expr Src a
DateShow =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Date/show"
    prettyPrimitiveExpression Expr Src a
Time =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Time"
    prettyPrimitiveExpression (TimeLiteral (Time.TimeOfDay Int
hh Int
mm Pico
seconds) Word
precision) =
        Doc Ann -> Doc Ann
literal
            (   forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (forall r. PrintfType r => String -> r
Printf.printf String
"%02d" Int
hh :: String)
            forall a. Semigroup a => a -> a -> a
<>  Doc Ann
":"
            forall a. Semigroup a => a -> a -> a
<>  forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (forall r. PrintfType r => String -> r
Printf.printf String
"%02d" Int
mm :: String)
            forall a. Semigroup a => a -> a -> a
<>  Doc Ann
":"
            forall a. Semigroup a => a -> a -> a
<>  forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (forall r. PrintfType r => String -> r
Printf.printf String
"%02d" Integer
ss :: String)
            forall a. Semigroup a => a -> a -> a
<>  forall ann. Doc ann
suffix
            )
      where
        magnitude :: Integer
        magnitude :: Integer
magnitude = Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Word
precision

        (Integer
ss, Integer
fraction) = forall a b. (RealFrac a, Integral b) => a -> b
truncate (Pico
seconds forall a. Num a => a -> a -> a
* forall a. Num a => Integer -> a
fromInteger Integer
magnitude) forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
magnitude

        suffix :: Doc ann
suffix
            | Word
precision forall a. Eq a => a -> a -> Bool
== Word
0 = Doc ann
""
            | Bool
otherwise      = Doc ann
"." forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (forall r. PrintfType r => String -> r
Printf.printf String
"%0*d" Word
precision Integer
fraction :: String)
    prettyPrimitiveExpression Expr Src a
TimeShow =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Time/show"
    prettyPrimitiveExpression Expr Src a
TimeZone =
        Doc Ann -> Doc Ann
builtin Doc Ann
"TimeZone"
    prettyPrimitiveExpression (TimeZoneLiteral (Time.TimeZone Int
minutes Bool
_ String
_)) =
        Doc Ann -> Doc Ann
literal
            (   Doc Ann
sign
            forall a. Semigroup a => a -> a -> a
<>  forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (forall r. PrintfType r => String -> r
Printf.printf String
"%02d" Int
_HH :: String)
            forall a. Semigroup a => a -> a -> a
<>  Doc Ann
":"
            forall a. Semigroup a => a -> a -> a
<>  forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (forall r. PrintfType r => String -> r
Printf.printf String
"%02d" Int
_MM :: String)
            )
      where
        sign :: Doc Ann
sign = if Int
0 forall a. Ord a => a -> a -> Bool
<= Int
minutes then Doc Ann
"+" else Doc Ann
"-"

        (Int
_HH, Int
_MM) = forall a. Num a => a -> a
abs Int
minutes forall a. Integral a => a -> a -> (a, a)
`divMod` Int
60
    prettyPrimitiveExpression Expr Src a
TimeZoneShow =
        Doc Ann -> Doc Ann
builtin Doc Ann
"TimeZone/show"
    prettyPrimitiveExpression Expr Src a
List =
        Doc Ann -> Doc Ann
builtin Doc Ann
"List"
    prettyPrimitiveExpression Expr Src a
ListBuild =
        Doc Ann -> Doc Ann
builtin Doc Ann
"List/build"
    prettyPrimitiveExpression Expr Src a
ListFold =
        Doc Ann -> Doc Ann
builtin Doc Ann
"List/fold"
    prettyPrimitiveExpression Expr Src a
ListLength =
        Doc Ann -> Doc Ann
builtin Doc Ann
"List/length"
    prettyPrimitiveExpression Expr Src a
ListHead =
        Doc Ann -> Doc Ann
builtin Doc Ann
"List/head"
    prettyPrimitiveExpression Expr Src a
ListLast =
        Doc Ann -> Doc Ann
builtin Doc Ann
"List/last"
    prettyPrimitiveExpression Expr Src a
ListIndexed =
        Doc Ann -> Doc Ann
builtin Doc Ann
"List/indexed"
    prettyPrimitiveExpression Expr Src a
ListReverse =
        Doc Ann -> Doc Ann
builtin Doc Ann
"List/reverse"
    prettyPrimitiveExpression Expr Src a
Optional =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Optional"
    prettyPrimitiveExpression Expr Src a
None =
        Doc Ann -> Doc Ann
builtin Doc Ann
"None"
    prettyPrimitiveExpression (BoolLit Bool
True) =
        Doc Ann -> Doc Ann
builtin Doc Ann
"True"
    prettyPrimitiveExpression (BoolLit Bool
False) =
        Doc Ann -> Doc Ann
builtin Doc Ann
"False"
    prettyPrimitiveExpression (IntegerLit Integer
a)
        | Integer
0 forall a. Ord a => a -> a -> Bool
<= Integer
a    = Doc Ann -> Doc Ann
literal Doc Ann
"+" forall a. Semigroup a => a -> a -> a
<> Integer -> Doc Ann
prettyNumber Integer
a
        | Bool
otherwise = Integer -> Doc Ann
prettyNumber Integer
a
    prettyPrimitiveExpression (NaturalLit Natural
a) =
        Natural -> Doc Ann
prettyNatural Natural
a
    prettyPrimitiveExpression (DoubleLit (DhallDouble Double
a)) =
        Double -> Doc Ann
prettyDouble Double
a
    prettyPrimitiveExpression (TextLit Chunks Src a
a) =
        forall a. Pretty a => Chunks Src a -> Doc Ann
prettyChunks Chunks Src a
a
    prettyPrimitiveExpression (BytesLit ByteString
a) =
        ByteString -> Doc Ann
prettyBytes ByteString
a
    prettyPrimitiveExpression (Record Map Text (RecordField Src a)
a) =
        forall a. Pretty a => Map Text (RecordField Src a) -> Doc Ann
prettyRecord Map Text (RecordField Src a)
a
    prettyPrimitiveExpression (RecordLit Map Text (RecordField Src a)
a) =
        forall a. Pretty a => Map Text (RecordField Src a) -> Doc Ann
prettyRecordLit Map Text (RecordField Src a)
a
    prettyPrimitiveExpression (Union Map Text (Maybe (Expr Src a))
a) =
        forall a. Pretty a => Map Text (Maybe (Expr Src a)) -> Doc Ann
prettyUnion Map Text (Maybe (Expr Src a))
a
    prettyPrimitiveExpression (ListLit Maybe (Expr Src a)
Nothing Seq (Expr Src a)
b) =
        [Doc Ann] -> Doc Ann
list (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression (forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Seq (Expr Src a)
b))
    prettyPrimitiveExpression Expr Src a
a
        | Just Doc Ann
doc <- forall a. Expr Src a -> Maybe (Doc Ann)
preserveSource Expr Src a
a =
            Doc Ann
doc
        | Note Src
_ Expr Src a
b <- Expr Src a
a =
            forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
b
        | Bool
otherwise =
            forall ann. Doc ann -> Doc ann
Pretty.group (forall {ann}. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short)
      where
        long :: Doc Ann
long =
            forall ann. Doc ann -> Doc ann
Pretty.align
                (Doc Ann
lparen forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
space forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Expr Src a
a forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
Pretty.hardline forall a. Semigroup a => a -> a -> a
<> Doc Ann
rparen)

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

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

        short :: Doc Ann
short = forall (list :: * -> *) key.
Foldable list =>
(key -> Doc Ann) -> list (Maybe Src, key, Maybe Src) -> Doc Ann
prettyKeys key -> Doc Ann
prettyKey NonEmpty (Maybe Src, key, Maybe Src)
key
            forall a. Semigroup a => a -> a -> a
<>  Doc Ann
" "
            forall a. Semigroup a => a -> a -> a
<>  Doc Ann
separator
            forall a. Semigroup a => a -> a -> a
<>  Doc Ann
" "
            forall a. Semigroup a => a -> a -> a
<>  case Maybe Src -> Maybe (Doc Ann)
renderSrcMaybe Maybe Src
mSrc of
                    Maybe (Doc Ann)
Nothing  -> forall a. Monoid a => a
mempty
                    Just Doc Ann
doc -> Doc Ann
doc forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
Pretty.hardline
            forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyValue Expr Src a
val

        long :: Doc Ann
long =  forall ann. Doc ann -> Doc ann
Pretty.align
                    (   forall (list :: * -> *) key.
Foldable list =>
(key -> Doc Ann) -> list (Maybe Src, key, Maybe Src) -> Doc Ann
prettyKeys key -> Doc Ann
prettyKey NonEmpty (Maybe Src, key, Maybe Src)
key
                    forall a. Semigroup a => a -> a -> a
<>  forall ann. Doc ann
preSeparator
                    )
            forall a. Semigroup a => a -> a -> a
<>  Doc Ann
separator
            forall a. Semigroup a => a -> a -> a
<>  case Maybe Src -> Maybe (Doc Ann)
renderSrcMaybe Maybe Src
mSrc of
                    Just Doc Ann
doc ->
                            forall ann. Doc ann
preComment
                        forall a. Semigroup a => a -> a -> a
<>  forall ann. Doc ann -> Doc ann
Pretty.align
                                (   Doc Ann
doc
                                forall a. Semigroup a => a -> a -> a
<>  forall ann. Doc ann
Pretty.hardline
                                forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyValue Expr Src a
val
                                )
                    Maybe (Doc Ann)
Nothing ->
                        case forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
val of
                            Some Expr Src a
val' ->
                                    Doc Ann
" "
                                forall a. Semigroup a => a -> a -> a
<>  Doc Ann -> Doc Ann
builtin Doc Ann
"Some"
                                forall a. Semigroup a => a -> a -> a
<>  case forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
val' of
                                        RecordCompletion Expr Src a
_T Expr Src a
r ->
                                                Doc Ann
" "
                                            forall a. Semigroup a => a -> a -> a
<>  forall {a} {a}.
(Pretty a, Pretty a) =>
Expr Src a -> Expr Src a -> Doc Ann
completion Expr Src a
_T Expr Src a
r

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

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

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

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

                            ShowConstructor Expr Src a
val' ->
                                    Doc Ann
" "
                                forall a. Semigroup a => a -> a -> a
<>  Doc Ann -> Doc Ann
keyword Doc Ann
"showConstructor"
                                forall a. Semigroup a => a -> a -> a
<>  case forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
val' of
                                        RecordCompletion Expr Src a
_T Expr Src a
r ->
                                                Doc Ann
" "
                                            forall a. Semigroup a => a -> a -> a
<>  forall {a} {a}.
(Pretty a, Pretty a) =>
Expr Src a -> Expr Src a -> Doc Ann
completion Expr Src a
_T Expr Src a
r
                                        Expr Src a
_ ->    forall ann. Doc ann
Pretty.hardline
                                            forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"    "
                                            forall a. Semigroup a => a -> a -> a
<>  forall a. Pretty a => Expr Src a -> Doc Ann
prettyImportExpression_ Expr Src a
val'

                            RecordCompletion Expr Src a
_T Expr Src a
r ->
                                Doc Ann
" " forall a. Semigroup a => a -> a -> a
<> forall {a} {a}.
(Pretty a, Pretty a) =>
Expr Src a -> Expr Src a -> Doc Ann
completion Expr Src a
_T Expr Src a
r

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

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

                            Expr Src a
_ ->
                                forall ann. Doc ann -> Doc ann
Pretty.group
                                    (   forall {ann}. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt (forall ann. Doc ann
Pretty.hardline forall a. Semigroup a => a -> a -> a
<> Doc Ann
"    ") Doc Ann
" "
                                    forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyValue Expr Src a
val
                                    )
          where
            (Doc ann
preSeparator, Doc ann
preComment) =
                case NonEmpty (Maybe Src, key, Maybe Src)
key of
                    (Maybe Src
_, key
_, Maybe Src
mSrc2) :| [] | Bool -> Bool
not (Maybe Src -> Bool
containsComment Maybe Src
mSrc2) ->
                        (Doc ann
" ", forall ann. Doc ann
Pretty.hardline forall a. Semigroup a => a -> a -> a
<> Doc ann
"    ")
                    NonEmpty (Maybe Src, key, Maybe Src)
_ ->
                        (forall ann. Doc ann
Pretty.hardline, Doc ann
" ")


    prettyRecord :: Pretty a => Map Text (RecordField Src a) -> Doc Ann
    prettyRecord :: forall a. Pretty a => Map Text (RecordField Src a) -> Doc Ann
prettyRecord =
        ( [(Doc Ann, Doc Ann)] -> Doc Ann
braces
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a key.
Pretty a =>
(key -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> KeyValue key Src a
-> (Doc Ann, Doc Ann)
prettyKeyValue Text -> Doc Ann
prettyAnyLabel forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Doc Ann
colon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {s} {a}. (k, RecordField s a) -> KeyValue k s a
adapt)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Ord k => Map k v -> [(k, v)]
Map.toList
        )
      where
        adapt :: (k, RecordField s a) -> KeyValue k s a
adapt (k
key, RecordField Maybe s
mSrc0 Expr s a
val Maybe s
mSrc1 Maybe s
mSrc2) = forall k s a.
NonEmpty (Maybe s, k, Maybe s)
-> Maybe s -> Expr s a -> KeyValue k s a
KeyValue (forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe s
mSrc0, k
key, Maybe s
mSrc1)) Maybe s
mSrc2 Expr s a
val

    prettyRecordLit :: Pretty a => Map Text (RecordField Src a) -> Doc Ann
    prettyRecordLit :: forall a. Pretty a => Map Text (RecordField Src a) -> Doc Ann
prettyRecordLit Map Text (RecordField Src a)
m
        | [ (Text
"date"    , forall {s} {a}. RecordField s a -> Expr s a
field -> d :: Expr Src a
d@DateLiteral{})
          , (Text
"time"    , forall {s} {a}. RecordField s a -> Expr s a
field -> t :: Expr Src a
t@TimeLiteral{})
          , (Text
"timeZone", forall {s} {a}. RecordField s a -> Expr s a
field -> z :: Expr Src a
z@TimeZoneLiteral{})
          ] <- forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn forall a b. (a, b) -> a
fst (forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField Src a)
m) =
              Doc Ann -> Doc Ann
literal
                  (   forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
d
                  forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"T"
                  forall a. Semigroup a => a -> a -> a
<>  forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
t
                  forall a. Semigroup a => a -> a -> a
<>  forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
z
                  )
        | [ (Text
"date"    , forall {s} {a}. RecordField s a -> Expr s a
field -> d :: Expr Src a
d@DateLiteral{})
          , (Text
"time"    , forall {s} {a}. RecordField s a -> Expr s a
field -> t :: Expr Src a
t@TimeLiteral{})
          ] <- forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn forall a b. (a, b) -> a
fst (forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField Src a)
m) =
              Doc Ann -> Doc Ann
literal
                  (   forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
d
                  forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"T"
                  forall a. Semigroup a => a -> a -> a
<>  forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
t
                  )
        | [ (Text
"time"    , forall {s} {a}. RecordField s a -> Expr s a
field -> t :: Expr Src a
t@TimeLiteral{})
          , (Text
"timeZone", forall {s} {a}. RecordField s a -> Expr s a
field -> z :: Expr Src a
z@TimeZoneLiteral{})
          ] <- forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn forall a b. (a, b) -> a
fst (forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField Src a)
m) =
              Doc Ann -> Doc Ann
literal
                  (   forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
t
                  forall a. Semigroup a => a -> a -> a
<>  forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
z
                  )
      where
        field :: RecordField s a -> Expr s a
field = forall s a. Expr s a -> Expr s a
Dhall.Syntax.shallowDenote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {s} {a}. RecordField s a -> Expr s a
recordFieldValue
    prettyRecordLit Map Text (RecordField Src a)
m = forall a.
Pretty a =>
([(Doc Ann, Doc Ann)] -> Doc Ann)
-> Map Text (RecordField Src a) -> Doc Ann
prettyRecordLike [(Doc Ann, Doc Ann)] -> Doc Ann
braces Map Text (RecordField Src a)
m

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

    prettyRecordLike
        :: Pretty a
        => ([(Doc Ann, Doc Ann)] -> Doc Ann)
        -> Map Text (RecordField Src a)
        -> Doc Ann
    prettyRecordLike :: forall a.
Pretty a =>
([(Doc Ann, Doc Ann)] -> Doc Ann)
-> Map Text (RecordField Src a) -> Doc Ann
prettyRecordLike [(Doc Ann, Doc Ann)] -> Doc Ann
braceStyle Map Text (RecordField Src a)
a
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
Data.Foldable.null Map Text (RecordField Src a)
a =
            Doc Ann
lbrace forall a. Semigroup a => a -> a -> a
<> Doc Ann
equals forall a. Semigroup a => a -> a -> a
<> Doc Ann
rbrace
        | Bool
otherwise =
            [(Doc Ann, Doc Ann)] -> Doc Ann
braceStyle (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Pretty a => KeyValue Text Src a -> (Doc Ann, Doc Ann)
prettyRecordEntry (forall a. Map Text (RecordField Src a) -> [KeyValue Text Src a]
consolidateRecordLiteral Map Text (RecordField Src a)
a))
      where
        prettyRecordEntry :: KeyValue Text Src a -> (Doc Ann, Doc Ann)
prettyRecordEntry kv :: KeyValue Text Src a
kv@(KeyValue NonEmpty (Maybe Src, Text, Maybe Src)
keys Maybe Src
mSrc2 Expr Src a
val) =
            case NonEmpty (Maybe Src, Text, Maybe Src)
keys of
                (Maybe Src
mSrc0, Text
key, Maybe Src
mSrc1) :| []
                    | Var (V Text
key' Int
0) <- forall s a. Expr s a -> Expr s a
Dhall.Syntax.shallowDenote Expr Src a
val
                    , Text
key forall a. Eq a => a -> a -> Bool
== Text
key'
                    , Bool -> Bool
not (Maybe Src -> Bool
containsComment Maybe Src
mSrc2) ->
                        forall a. a -> (a, a)
duplicate (forall (list :: * -> *) key.
Foldable list =>
(key -> Doc Ann) -> list (Maybe Src, key, Maybe Src) -> Doc Ann
prettyKeys Text -> Doc Ann
prettyAnyLabel [(Maybe Src
mSrc0, Text
key, Maybe Src
mSrc1)])
                NonEmpty (Maybe Src, Text, Maybe Src)
_ ->
                    forall a key.
Pretty a =>
(key -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> KeyValue key Src a
-> (Doc Ann, Doc Ann)
prettyKeyValue Text -> Doc Ann
prettyAnyLabel forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Doc Ann
equals KeyValue Text Src a
kv

    prettyAlternative :: (Text, Maybe (Expr Src a)) -> (Doc Ann, Doc Ann)
prettyAlternative (Text
key, Just Expr Src a
val) =
        forall a key.
Pretty a =>
(key -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> KeyValue key Src a
-> (Doc Ann, Doc Ann)
prettyKeyValue Text -> Doc Ann
prettyAnyLabel forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Doc Ann
colon (forall key s a. NonEmpty key -> Expr s a -> KeyValue key s a
makeKeyValue (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
key) Expr Src a
val)
    prettyAlternative (Text
key, Maybe (Expr Src a)
Nothing) =
        forall a. a -> (a, a)
duplicate (Text -> Doc Ann
prettyAnyLabel Text
key)

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

    prettyBytes :: ByteString -> Doc Ann
    prettyBytes :: ByteString -> Doc Ann
prettyBytes ByteString
bytes =
        Doc Ann -> Doc Ann
literal (forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (Text
"0x\"" forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
prettyBase16 ByteString
bytes forall a. Semigroup a => a -> a -> a
<> Text
"\""))

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

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

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

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

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

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

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

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


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

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

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

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

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

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

-- | Escape control characters by moving them into string interpolations
--
-- >>> escapeControlCharacters (Chunks [] "\n\NUL\b\f\t")
-- Chunks [("\n",TextLit (Chunks [] "\NUL\b\f"))] "\t"
escapeControlCharacters :: Chunks s a -> Chunks s a
escapeControlCharacters :: forall s a. Chunks s a -> Chunks s a
escapeControlCharacters = forall s a. (Text -> Chunks s a) -> Chunks s a -> Chunks s a
splitWith (forall s a. (Char -> Bool) -> Text -> Chunks s a
splitOnPredicate Char -> Bool
predicate)
  where
    predicate :: Char -> Bool
predicate Char
c = Char -> Bool
Data.Char.isControl Char
c Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
' ' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\t' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n'

-- | Escape @'${@ correctly
--
-- See: https://github.com/dhall-lang/dhall-haskell/issues/2078
escapeSingleQuoteBeforeInterpolation :: Chunks s a -> Chunks s a
escapeSingleQuoteBeforeInterpolation :: forall s a. Chunks s a -> Chunks s a
escapeSingleQuoteBeforeInterpolation = forall s a. (Text -> Chunks s a) -> Chunks s a -> Chunks s a
splitWith forall {s} {a}. Text -> Chunks s a
f
  where
    f :: Text -> Chunks s a
f Text
text =
        case Text -> Text -> [Text]
Text.splitOn Text
"'${" Text
text of
            -- `splitOn` should never return an empty list, but just in case…
            []     -> forall a. Monoid a => a
mempty
            Text
t : [Text]
ts -> forall {s} {a}. Text -> [Text] -> Chunks s a
loop Text
t [Text]
ts

    loop :: Text -> [Text] -> Chunks s a
loop Text
head_ [Text]
tail_ =
        case [Text]
tail_ of
            [] ->
                forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
head_
            Text
newHead : [Text]
newTail ->
                    forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [ (Text
head_, forall s a. Chunks s a -> Expr s a
TextLit (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
"'")) ] Text
"${"
                forall a. Semigroup a => a -> a -> a
<>  Text -> [Text] -> Chunks s a
loop Text
newHead [Text]
newTail

{-| You can think of this as sort of like `concatMap` for `Chunks`

    Given a function that splits plain text into interpolated chunks, apply
    that function to each uninterpolated span to yield a new
    possibly-interpolated span, and flatten the results.
-}
splitWith :: (Text -> Chunks s a) -> Chunks s a -> Chunks s a
splitWith :: forall s a. (Text -> Chunks s a) -> Chunks s a -> Chunks s a
splitWith Text -> Chunks s a
splitter (Chunks [(Text, Expr s a)]
xys Text
z) = forall a. Monoid a => [a] -> a
mconcat ([Chunks s a]
xys' forall a. [a] -> [a] -> [a]
++ [ Text -> Chunks s a
splitter Text
z ])
  where
    xys' :: [Chunks s a]
xys' = do
        (Text
x, Expr s a
y) <- [(Text, Expr s a)]
xys

        [ Text -> Chunks s a
splitter Text
x, forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [ (Text
"", Expr s a
y) ] Text
"" ]

-- | Split `Data.Text.Text` into interpolated chunks, where all characters
-- matching the predicate are pushed into a string interpolation.
--
-- >>> splitOnPredicate (== 'x') ""
-- Chunks [] ""
-- >>> splitOnPredicate (== 'x') " xx "
-- Chunks [(" ",TextLit (Chunks [] "xx"))] " "
-- >>> splitOnPredicate (== 'x') "xx"
-- Chunks [("",TextLit (Chunks [] "xx"))] ""
--
-- prop> \(Fun _ p) s -> let {t = Text.pack s; Chunks xys z = splitOnPredicate p t} in foldMap (\(x, TextLit (Chunks [] y)) -> x <> y) xys <> z == t
splitOnPredicate :: (Char -> Bool) -> Text -> Chunks s a
splitOnPredicate :: forall s a. (Char -> Bool) -> Text -> Chunks s a
splitOnPredicate Char -> Bool
predicate Text
text
    | Text -> Bool
Text.null Text
b =
        forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
a
    | Bool
otherwise =
        forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks ((Text
a, forall s a. Chunks s a -> Expr s a
TextLit (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
c)) forall a. a -> [a] -> [a]
: forall {s} {a}. [(Text, Expr s a)]
e) Text
f
  where
    (Text
a, Text
b) = (Char -> Bool) -> Text -> (Text, Text)
Text.break Char -> Bool
predicate Text
text

    (Text
c, Text
d) = (Char -> Bool) -> Text -> (Text, Text)
Text.span Char -> Bool
predicate Text
b

    Chunks [(Text, Expr s a)]
e Text
f = forall s a. (Char -> Bool) -> Text -> Chunks s a
splitOnPredicate Char -> Bool
predicate Text
d

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

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

data KeyValue k s a = KeyValue
    { forall k s a. KeyValue k s a -> NonEmpty (Maybe s, k, Maybe s)
_keyValueKeys  :: NonEmpty (Maybe s, k , Maybe s)
    , forall k s a. KeyValue k s a -> Maybe s
_keyValueSrc   :: Maybe s
    , forall k s a. KeyValue k s a -> Expr s a
_keyValueValue :: Expr s a
    }

makeKeyValue :: NonEmpty key -> Expr s a -> KeyValue key s a
makeKeyValue :: forall key s a. NonEmpty key -> Expr s a -> KeyValue key s a
makeKeyValue NonEmpty key
keys Expr s a
expr = forall k s a.
NonEmpty (Maybe s, k, Maybe s)
-> Maybe s -> Expr s a -> KeyValue k s a
KeyValue (forall {b} {a} {a}. b -> (Maybe a, b, Maybe a)
adapt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty key
keys) forall a. Maybe a
Nothing Expr s a
expr
  where
    adapt :: b -> (Maybe a, b, Maybe a)
adapt b
key = (forall a. Maybe a
Nothing, b
key, forall a. Maybe a
Nothing)

{- This utility function converts
   `{ x = { y = { z = 1 } } }` to `{ x.y.z = 1 }`
-}
consolidateRecordLiteral
    :: Map Text (RecordField Src a) -> [KeyValue Text Src a]
consolidateRecordLiteral :: forall a. Map Text (RecordField Src a) -> [KeyValue Text Src a]
consolidateRecordLiteral = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. (Text, RecordField Src a) -> [KeyValue Text Src a]
adapt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Ord k => Map k v -> [(k, v)]
Map.toList
  where
    adapt :: (Text, RecordField Src a) -> [KeyValue Text Src a]
    adapt :: forall a. (Text, RecordField Src a) -> [KeyValue Text Src a]
adapt (Text
key, RecordField Maybe Src
mSrc0 Expr Src a
val Maybe Src
mSrc1 Maybe Src
mSrc2)
        | Bool -> Bool
not (Maybe Src -> Bool
containsComment Maybe Src
mSrc2)
        , RecordLit Map Text (RecordField Src a)
m <- Expr Src a
e
        , [ KeyValue NonEmpty (Maybe Src, Text, Maybe Src)
keys Maybe Src
mSrc2' Expr Src a
val' ] <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. (Text, RecordField Src a) -> [KeyValue Text Src a]
adapt (forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField Src a)
m) =
            [ forall k s a.
NonEmpty (Maybe s, k, Maybe s)
-> Maybe s -> Expr s a -> KeyValue k s a
KeyValue (forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.cons (Maybe Src
mSrc0, Text
key, Maybe Src
mSrc1) NonEmpty (Maybe Src, Text, Maybe Src)
keys) Maybe Src
mSrc2' Expr Src a
val' ]

        | Combine Maybe CharacterSet
_ (Just Text
_) Expr Src a
l Expr Src a
r <- Expr Src a
e =
            forall a. (Text, RecordField Src a) -> [KeyValue Text Src a]
adapt (Text
key, forall s a. Expr s a -> RecordField s a
makeRecordField Expr Src a
l) forall a. Semigroup a => a -> a -> a
<> forall a. (Text, RecordField Src a) -> [KeyValue Text Src a]
adapt (Text
key, forall s a. Expr s a -> RecordField s a
makeRecordField Expr Src a
r)
        | Bool
otherwise =
            [ forall k s a.
NonEmpty (Maybe s, k, Maybe s)
-> Maybe s -> Expr s a -> KeyValue k s a
KeyValue (forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Src
mSrc0, Text
key, Maybe Src
mSrc1)) Maybe Src
mSrc2 Expr Src a
val ]
      where
        e :: Expr Src a
e = forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
val

-- | Escape a `Data.Text.Text` literal using Dhall's escaping rules for
--   single-quoted @Text@
escapeSingleQuotedText :: Chunks s a -> Chunks s a
escapeSingleQuotedText :: forall s a. Chunks s a -> Chunks s a
escapeSingleQuotedText = forall s a. (Text -> Chunks s a) -> Chunks s a -> Chunks s a
splitWith forall {s} {a}. Text -> Chunks s a
f
  where
    f :: Text -> Chunks s a
f Text
inputText = forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
outputText
      where
        outputText :: Text
outputText =
            Text -> Text -> Text -> Text
Text.replace Text
"${" Text
"''${" (Text -> Text -> Text -> Text
Text.replace Text
"''" Text
"'''" Text
inputText)

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

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

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

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

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

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

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

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

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

{-| Convert an expression representing a temporal value to `Data.Text.Text`, if
    possible

    This is used by downstream integrations (e.g. `dhall-json` for treating
    temporal values as strings
-}
temporalToText :: Pretty a => Expr s a -> Maybe Text
temporalToText :: forall a s. Pretty a => Expr s a -> Maybe Text
temporalToText Expr s a
e = case Expr s a
e of
    RecordLit Map Text (RecordField s a)
m
        | [ (Text
"date"    , forall {s} {a}. RecordField s a -> Expr s a
field -> DateLiteral{})
          , (Text
"time"    , forall {s} {a}. RecordField s a -> Expr s a
field -> TimeLiteral{})
          , (Text
"timeZone", forall {s} {a}. RecordField s a -> Expr s a
field -> TimeZoneLiteral{})
          ] <- forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn forall a b. (a, b) -> a
fst (forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField s a)
m) -> Maybe Text
rendered
        | [ (Text
"date"    , forall {s} {a}. RecordField s a -> Expr s a
field -> DateLiteral{})
          , (Text
"time"    , forall {s} {a}. RecordField s a -> Expr s a
field -> TimeLiteral{})
          ] <- forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn forall a b. (a, b) -> a
fst (forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField s a)
m) -> Maybe Text
rendered
        | [ (Text
"time"    , forall {s} {a}. RecordField s a -> Expr s a
field -> TimeLiteral{})
          , (Text
"timeZone", forall {s} {a}. RecordField s a -> Expr s a
field -> TimeZoneLiteral{})
          ] <- forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn forall a b. (a, b) -> a
fst (forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField s a)
m) -> Maybe Text
rendered
    DateLiteral{} -> Maybe Text
rendered
    TimeLiteral{} -> Maybe Text
rendered
    TimeZoneLiteral{} -> Maybe Text
rendered
    Expr s a
_ -> forall a. Maybe a
Nothing
  where
    field :: RecordField s a -> Expr s a
field = forall s a. Expr s a -> Expr s a
Dhall.Syntax.shallowDenote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {s} {a}. RecordField s a -> Expr s a
recordFieldValue

    rendered :: Maybe Text
rendered = forall a. a -> Maybe a
Just (forall a. Pretty a => a -> Text
prettyToStrictText Expr s a
e)

prettyBase16 :: ByteString -> Text
prettyBase16 :: ByteString -> Text
prettyBase16 ByteString
bytes =
    case ByteString -> Either UnicodeException Text
Encoding.decodeUtf8' (ByteString -> ByteString
Base16.encode ByteString
bytes) of
        Left UnicodeException
exception ->
            Text -> forall b. b
Operations.internalError
                (Text
"prettyBase16: base16-encoded bytes could not be decoded as UTF-8 text: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall e. Exception e => e -> String
Exception.displayException UnicodeException
exception))
        Right Text
text ->
            Text -> Text
Text.toUpper Text
text

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