{-# 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
    , 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.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 GHC.Generics               (Generic)
import Language.Haskell.TH.Syntax (Lift)
import Numeric.Natural            (Natural)
import Prettyprinter              (Doc, Pretty, space)

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.Time                     as Time
import qualified Dhall.Map                     as Map
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
(Int -> Ann -> ShowS)
-> (Ann -> String) -> ([Ann] -> ShowS) -> Show Ann
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ann] -> ShowS
$cshowList :: [Ann] -> ShowS
show :: Ann -> String
$cshow :: Ann -> String
showsPrec :: Int -> Ann -> ShowS
$cshowsPrec :: Int -> Ann -> ShowS
Show

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

-- | This type determines whether to render code as `ASCII` or `Unicode`
data CharacterSet = ASCII | Unicode
    deriving (CharacterSet -> CharacterSet -> Bool
(CharacterSet -> CharacterSet -> Bool)
-> (CharacterSet -> CharacterSet -> Bool) -> Eq CharacterSet
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
Eq CharacterSet
-> (CharacterSet -> CharacterSet -> Ordering)
-> (CharacterSet -> CharacterSet -> Bool)
-> (CharacterSet -> CharacterSet -> Bool)
-> (CharacterSet -> CharacterSet -> Bool)
-> (CharacterSet -> CharacterSet -> Bool)
-> (CharacterSet -> CharacterSet -> CharacterSet)
-> (CharacterSet -> CharacterSet -> CharacterSet)
-> Ord 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
$cp1Ord :: Eq CharacterSet
Ord, Int -> CharacterSet -> ShowS
[CharacterSet] -> ShowS
CharacterSet -> String
(Int -> CharacterSet -> ShowS)
-> (CharacterSet -> String)
-> ([CharacterSet] -> ShowS)
-> Show CharacterSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharacterSet] -> ShowS
$cshowList :: [CharacterSet] -> ShowS
show :: CharacterSet -> String
$cshow :: CharacterSet -> String
showsPrec :: Int -> CharacterSet -> ShowS
$cshowsPrec :: Int -> CharacterSet -> ShowS
Show, Typeable CharacterSet
DataType
Constr
Typeable CharacterSet
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CharacterSet -> c CharacterSet)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CharacterSet)
-> (CharacterSet -> Constr)
-> (CharacterSet -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> CharacterSet -> CharacterSet)
-> (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 u. (forall d. Data d => d -> u) -> CharacterSet -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CharacterSet -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CharacterSet -> m CharacterSet)
-> Data CharacterSet
CharacterSet -> DataType
CharacterSet -> Constr
(forall b. Data b => b -> b) -> CharacterSet -> CharacterSet
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CharacterSet -> c CharacterSet
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cUnicode :: Constr
$cASCII :: Constr
$tCharacterSet :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> CharacterSet -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CharacterSet -> u
gmapQ :: (forall d. Data d => d -> u) -> CharacterSet -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CharacterSet -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable CharacterSet
Data, (forall x. CharacterSet -> Rep CharacterSet x)
-> (forall x. Rep CharacterSet x -> CharacterSet)
-> Generic CharacterSet
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, CharacterSet -> Q Exp
CharacterSet -> Q (TExp CharacterSet)
(CharacterSet -> Q Exp)
-> (CharacterSet -> Q (TExp CharacterSet)) -> Lift CharacterSet
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: CharacterSet -> Q (TExp CharacterSet)
$cliftTyped :: CharacterSet -> Q (TExp CharacterSet)
lift :: CharacterSet -> Q Exp
$clift :: CharacterSet -> Q Exp
Lift, CharacterSet -> ()
(CharacterSet -> ()) -> NFData 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") = CharacterSet -> Parser CharacterSet
forall (f :: * -> *) a. Applicative f => a -> f a
pure CharacterSet
Unicode
  parseJSON (String Text
"ascii") = CharacterSet -> Parser CharacterSet
forall (f :: * -> *) a. Applicative f => a -> f a
pure CharacterSet
ASCII
  parseJSON v :: Value
v@(String Text
_) = Value -> Parser CharacterSet
forall a. Value -> Parser a
unexpected Value
v
  parseJSON Value
v = String -> Value -> Parser CharacterSet
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 :: Expr Src a -> CharacterSet
detectCharacterSet = Getting CharacterSet (Expr Src a) CharacterSet
-> Expr Src a -> CharacterSet
forall a s. Getting a s a -> s -> a
foldOf (LensLike' (Const CharacterSet) (Expr Src a) (Expr Src a)
-> LensLike' (Const CharacterSet) (Expr Src a) (Expr Src a)
forall (f :: * -> *) a.
(Applicative f, Contravariant f) =>
LensLike' f a a -> LensLike' f a a
cosmosOf LensLike' (Const CharacterSet) (Expr Src a) (Expr Src a)
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
subExpressions LensLike' (Const CharacterSet) (Expr Src a) (Expr Src a)
-> Getting CharacterSet (Expr Src a) CharacterSet
-> Getting CharacterSet (Expr Src a) CharacterSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr Src a -> CharacterSet)
-> Getting CharacterSet (Expr Src a) CharacterSet
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Expr Src a -> CharacterSet
forall s a. Expr s a -> CharacterSet
exprToCharacterSet)
  where
    exprToCharacterSet :: Expr s a -> CharacterSet
exprToCharacterSet = \case
        Embed a
_ -> CharacterSet
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 s a
_ Expr s a
_ Expr s a
_ -> CharacterSet
Unicode
        Equivalent (Just CharacterSet
Unicode) Expr s a
_ Expr s a
_ -> CharacterSet
Unicode
        Expr s a
_ -> CharacterSet
forall a. Monoid a => a
mempty

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

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

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

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

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

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

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

    oldLines :: [Text]
oldLines = Text -> Text -> [Text]
Text.splitOn Text
"\n" Text
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) = (Text -> Text -> Text) -> Text -> [Text] -> Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Text -> Text -> Text
commonPrefix (Text -> Text
spacePrefix Text
l) [Text]
ls

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

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

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

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

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

{-| 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
"" -> Maybe (Doc Ann)
forall a. Maybe a
Nothing
        Text
t  -> Doc Ann -> Maybe (Doc Ann)
forall a. a -> Maybe a
Just (Text -> Doc Ann
renderComment Text
t)
renderSrcMaybe Maybe Src
_ = Maybe (Doc Ann)
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  = Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Keyword
syntax :: Doc Ann -> Doc Ann
syntax   = Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Syntax
label :: Doc Ann -> Doc Ann
label    = Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Label
literal :: Doc Ann -> Doc Ann
literal  = Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Literal
builtin :: Doc Ann -> Doc Ann
builtin  = Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Builtin
operator :: Doc Ann -> Doc Ann
operator = Ann -> Doc Ann -> Doc Ann
forall ann. ann -> Doc ann -> Doc ann
Pretty.annotate Ann
Operator

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    long :: Doc Ann
long =
        case ((Maybe Src, key, Maybe Src) -> Doc Ann)
-> [(Maybe Src, key, Maybe Src)] -> [Doc Ann]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Src, key, Maybe Src) -> Doc Ann
prettyKey (list (Maybe Src, key, Maybe Src) -> [(Maybe Src, key, Maybe Src)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList list (Maybe Src, key, Maybe Src)
keys) of
            []       -> Doc Ann
forall a. Monoid a => a
mempty
            [Doc Ann
doc]    -> Doc Ann
doc
            Doc Ann
doc:[Doc Ann]
docs ->
                  Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
                (Doc Ann -> Doc Ann)
-> ([Doc Ann] -> Doc Ann) -> [Doc Ann] -> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Ann] -> Doc Ann
forall a. Monoid a => [a] -> a
mconcat
                ([Doc Ann] -> Doc Ann)
-> ([Doc Ann] -> [Doc Ann]) -> [Doc Ann] -> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Ann -> [Doc Ann] -> [Doc Ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
Pretty.punctuate (Doc Ann
forall ann. Doc ann
Pretty.hardline Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
". ")
                ([Doc Ann] -> Doc Ann) -> [Doc Ann] -> Doc Ann
forall a b. (a -> b) -> a -> b
$ Int -> Doc Ann -> Doc Ann
forall ann. Int -> Doc ann -> Doc ann
Pretty.indent Int
2 Doc Ann
doc Doc Ann -> [Doc Ann] -> [Doc Ann]
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) =
          Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
        (Doc Ann -> Doc Ann)
-> ([Maybe (Doc Ann)] -> Doc Ann) -> [Maybe (Doc Ann)] -> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Ann] -> Doc Ann
forall a. Monoid a => [a] -> a
mconcat
        ([Doc Ann] -> Doc Ann)
-> ([Maybe (Doc Ann)] -> [Doc Ann]) -> [Maybe (Doc Ann)] -> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Ann -> [Doc Ann] -> [Doc Ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
Pretty.punctuate Doc Ann
forall ann. Doc ann
Pretty.hardline
        ([Doc Ann] -> [Doc Ann])
-> ([Maybe (Doc Ann)] -> [Doc Ann])
-> [Maybe (Doc Ann)]
-> [Doc Ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Doc Ann)] -> [Doc Ann]
forall a. [Maybe a] -> [a]
Data.Maybe.catMaybes
        ([Maybe (Doc Ann)] -> Doc Ann) -> [Maybe (Doc Ann)] -> Doc Ann
forall a b. (a -> b) -> a -> b
$ [ Maybe Src -> Maybe (Doc Ann)
renderSrcMaybe Maybe Src
mSrc0
          , Doc Ann -> Maybe (Doc Ann)
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
    | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
a    = Doc Ann
lbrace Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
rbrace
    | Bool
otherwise = [(Doc Ann, Doc Ann)] -> Doc Ann
braces ((Text -> (Doc Ann, Doc Ann)) -> [Text] -> [(Doc Ann, Doc Ann)]
forall a b. (a -> b) -> [a] -> [b]
map (Doc Ann -> (Doc Ann, Doc Ann)
forall a. a -> (a, a)
duplicate (Doc Ann -> (Doc Ann, Doc Ann))
-> (Text -> Doc Ann) -> Text -> (Doc Ann, Doc Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Ann
prettyAnyLabel) [Text]
a)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

This means the structure of parsed let-blocks is preserved.
-}
prettyCharacterSet :: Pretty a => CharacterSet -> Expr Src a -> Doc Ann
prettyCharacterSet :: CharacterSet -> Expr Src a -> Doc Ann
prettyCharacterSet CharacterSet
characterSet = Expr Src a -> 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
..} = CharacterSet -> PrettyPrinters a
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 :: 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
..} = CharacterSet -> PrettyPrinters a
forall a. Pretty a => CharacterSet -> PrettyPrinters a
prettyPrinters CharacterSet
Unicode

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

prettyPrinters :: Pretty a => CharacterSet -> PrettyPrinters a
prettyPrinters :: CharacterSet -> PrettyPrinters a
prettyPrinters CharacterSet
characterSet =
    PrettyPrinters :: forall a.
(Expr Src a -> Doc Ann)
-> (Expr Src a -> Doc Ann) -> PrettyPrinters a
PrettyPrinters{Expr Src a -> Doc Ann
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 =
        Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Expr Src a
expression)

    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) =
            Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short) Doc Ann -> [Doc Ann] -> [Doc Ann]
forall a. a -> [a] -> [a]
: Expr Src a -> [Doc Ann]
docs Expr Src a
c
          where
            long :: Doc Ann
long =  (CharacterSet -> Doc Ann
lambda CharacterSet
characterSet Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
                    (   (Doc Ann
lparen Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Text -> Doc Ann
prettyLabel Text
a
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
Pretty.hardline
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  (Doc Ann
colon Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space)
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyExpression Expr Src a
b
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
Pretty.hardline
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
rparen
                    )

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

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

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

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

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

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

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

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

        isSpace :: Char -> Bool
isSpace Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'
        stripSpaces :: Text -> Text
stripSpaces =
            (Char -> Bool) -> Text -> Text
Text.dropAround Char -> Bool
isSpace
          (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"\n"
          ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> Text -> Text
Text.dropWhileEnd Char -> Bool
isSpace)
          ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
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) =
            Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short)
          where
            long :: Doc Ann
long =  Doc Ann -> Doc Ann
keyword Doc Ann
"let" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space
                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
                    (   (Text -> Text) -> Maybe Src -> Doc Ann
renderSrc Text -> Text
stripSpaces Maybe Src
src0
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Text -> Doc Ann
prettyLabel Text
c Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
space Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Maybe Src -> Doc Ann
renderSrc Text -> Text
stripSpaces Maybe Src
src1
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
equals Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
Pretty.hardline Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Maybe Src -> Doc Ann
renderSrc Text -> Text
stripNewline Maybe Src
src2
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"  " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr Src a -> Doc Ann
prettyExpression Expr Src a
e
                    )

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

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

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

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

        (Doc Ann
update, Doc Ann
_) =
            (WithComponent -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> KeyValue WithComponent Src a
-> (Doc Ann, 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 Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyOperatorExpression Doc Ann
equals
                (NonEmpty WithComponent
-> Expr Src a -> KeyValue WithComponent Src a
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) =
        Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short)
      where
        short :: Doc Ann
short = Doc Ann -> Doc Ann
keyword Doc Ann
"assert" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
colon Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr Src a -> Doc Ann
prettyExpression Expr Src a
a

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    prettyPrimitiveExpression :: Pretty a => Expr Src a -> Doc Ann
    prettyPrimitiveExpression :: Expr Src a -> Doc Ann
prettyPrimitiveExpression (Var Var
a) =
        Var -> Doc Ann
prettyVar Var
a
    prettyPrimitiveExpression (Const Const
k) =
        Const -> Doc Ann
prettyConst Const
k
    prettyPrimitiveExpression Expr Src a
Bool =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Bool"
    prettyPrimitiveExpression Expr Src a
Natural =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural"
    prettyPrimitiveExpression Expr Src a
NaturalFold =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/fold"
    prettyPrimitiveExpression Expr Src a
NaturalBuild =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/build"
    prettyPrimitiveExpression Expr Src a
NaturalIsZero =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/isZero"
    prettyPrimitiveExpression Expr Src a
NaturalEven =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/even"
    prettyPrimitiveExpression Expr Src a
NaturalOdd =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/odd"
    prettyPrimitiveExpression Expr Src a
NaturalToInteger =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/toInteger"
    prettyPrimitiveExpression Expr Src a
NaturalShow =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/show"
    prettyPrimitiveExpression Expr Src a
NaturalSubtract =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Natural/subtract"
    prettyPrimitiveExpression Expr Src a
Integer =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Integer"
    prettyPrimitiveExpression Expr Src a
IntegerClamp =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Integer/clamp"
    prettyPrimitiveExpression Expr Src a
IntegerNegate =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Integer/negate"
    prettyPrimitiveExpression Expr Src a
IntegerShow =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Integer/show"
    prettyPrimitiveExpression Expr Src a
IntegerToDouble =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Integer/toDouble"
    prettyPrimitiveExpression Expr Src a
Double =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Double"
    prettyPrimitiveExpression Expr Src a
DoubleShow =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Double/show"
    prettyPrimitiveExpression Expr Src a
Text =
        Doc Ann -> Doc Ann
builtin Doc Ann
"Text"
    prettyPrimitiveExpression Expr Src a
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
            (   String -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (String -> Integer -> String
forall r. PrintfType r => String -> r
Printf.printf String
"%04d" Integer
_HHHH :: String)
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"-"
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  String -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (String -> Int -> String
forall r. PrintfType r => String -> r
Printf.printf String
"%02d" Int
_MM :: String)
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"-"
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  String -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (String -> Int -> String
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
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
            (   String -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (String -> Int -> String
forall r. PrintfType r => String -> r
Printf.printf String
"%02d" Int
hh :: String)
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
":"
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  String -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (String -> Int -> String
forall r. PrintfType r => String -> r
Printf.printf String
"%02d" Int
mm :: String)
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
":"
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  String -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (String -> Integer -> String
forall r. PrintfType r => String -> r
Printf.printf String
"%02d" Integer
ss :: String)
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
suffix
            )
      where
        magnitude :: Integer
        magnitude :: Integer
magnitude = Integer
10 Integer -> Word -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Word
precision

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

        suffix :: Doc ann
suffix
            | Word
precision Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = Doc ann
""
            | Bool
otherwise      = Doc ann
"." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Integer
fraction
    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
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  String -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (String -> Int -> String
forall r. PrintfType r => String -> r
Printf.printf String
"%02d" Int
_HH :: String)
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
":"
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  String -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (String -> Int -> String
forall r. PrintfType r => String -> r
Printf.printf String
"%02d" Int
_MM :: String)
            )
      where
        sign :: Doc Ann
sign = if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
minutes then Doc Ann
"+" else Doc Ann
"-"

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

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

    prettyKeyValue
        :: Pretty a
        => (key -> Doc Ann)
        -> (Expr Src a -> Doc Ann)
        -> Doc Ann
        -> KeyValue key Src a
        -> (Doc Ann, Doc Ann)
    prettyKeyValue :: (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) =
        Doc Ann -> (Doc Ann, Doc Ann)
forall a. a -> (a, a)
duplicate (Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc Ann
long Doc Ann
short))
      where
        completion :: Expr Src a -> Expr Src a -> Doc Ann
completion Expr Src a
_T Expr Src a
r =
                Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettySelectorExpression Expr Src a
_T
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
doubleColon
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  case Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
r of
                    RecordLit Map Text (RecordField Src a)
kvs ->
                        Int -> Map Text (RecordField Src a) -> Doc Ann
forall a.
Pretty a =>
Int -> Map Text (RecordField Src a) -> Doc Ann
prettyCompletionLit Int
2 Map Text (RecordField Src a)
kvs
                    Expr Src a
_ ->
                        Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettySelectorExpression Expr Src a
r

        short :: Doc Ann
short = (key -> Doc Ann) -> NonEmpty (Maybe Src, key, Maybe Src) -> Doc Ann
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
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
" "
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
separator
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
" "
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  case Maybe Src -> Maybe (Doc Ann)
renderSrcMaybe Maybe Src
mSrc of
                    Maybe (Doc Ann)
Nothing  -> Doc Ann
forall a. Monoid a => a
mempty
                    Just Doc Ann
doc -> Doc Ann
doc Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
Pretty.hardline
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyValue Expr Src a
val

        long :: Doc Ann
long =  Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
                    (   (key -> Doc Ann) -> NonEmpty (Maybe Src, key, Maybe Src) -> Doc Ann
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
                    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
preSeparator
                    )
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
separator
            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  case Maybe Src -> Maybe (Doc Ann)
renderSrcMaybe Maybe Src
mSrc of
                    Just Doc Ann
doc ->
                            Doc Ann
forall ann. Doc ann
preComment
                        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.align
                                (   Doc Ann
doc
                                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
Pretty.hardline
                                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
prettyValue Expr Src a
val
                                )
                    Maybe (Doc Ann)
Nothing ->
                        case Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
val of
                            Some Expr Src a
val' ->
                                    Doc Ann
" "
                                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann -> Doc Ann
builtin Doc Ann
"Some"
                                Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  case Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
val' of
                                        RecordCompletion Expr Src a
_T Expr Src a
r ->
                                                Doc Ann
" "
                                            Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Expr Src a -> Doc Ann
forall a a.
(Pretty a, Pretty a) =>
Expr Src a -> Expr Src a -> Doc Ann
completion Expr Src a
_T Expr Src a
r

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

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

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

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

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

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

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

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

                            Expr Src a
_ ->
                                Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann
Pretty.group
                                    (   Doc Ann -> Doc Ann -> Doc Ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt (Doc Ann
forall ann. Doc ann
Pretty.hardline Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"    ") Doc Ann
" "
                                    Doc Ann -> Doc Ann -> 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
" ", Doc ann
forall ann. Doc ann
Pretty.hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"    ")
                    NonEmpty (Maybe Src, key, Maybe Src)
_ ->
                        (Doc ann
forall ann. Doc ann
Pretty.hardline, Doc ann
" ")


    prettyRecord :: Pretty a => Map Text (RecordField Src a) -> Doc Ann
    prettyRecord :: Map Text (RecordField Src a) -> Doc Ann
prettyRecord =
        ( [(Doc Ann, Doc Ann)] -> Doc Ann
braces
        ([(Doc Ann, Doc Ann)] -> Doc Ann)
-> (Map Text (RecordField Src a) -> [(Doc Ann, Doc Ann)])
-> Map Text (RecordField Src a)
-> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, RecordField Src a) -> (Doc Ann, Doc Ann))
-> [(Text, RecordField Src a)] -> [(Doc Ann, Doc Ann)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> KeyValue Text Src a
-> (Doc Ann, 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 Text -> Doc Ann
prettyAnyLabel Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Doc Ann
colon (KeyValue Text Src a -> (Doc Ann, Doc Ann))
-> ((Text, RecordField Src a) -> KeyValue Text Src a)
-> (Text, RecordField Src a)
-> (Doc Ann, Doc Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, RecordField Src a) -> KeyValue Text Src a
forall k s a. (k, RecordField s a) -> KeyValue k s a
adapt)
        ([(Text, RecordField Src a)] -> [(Doc Ann, Doc Ann)])
-> (Map Text (RecordField Src a) -> [(Text, RecordField Src a)])
-> Map Text (RecordField Src a)
-> [(Doc Ann, Doc Ann)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text (RecordField Src a) -> [(Text, RecordField Src a)]
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) = NonEmpty (Maybe s, k, Maybe s)
-> Maybe s -> Expr s a -> KeyValue k s a
forall k s a.
NonEmpty (Maybe s, k, Maybe s)
-> Maybe s -> Expr s a -> KeyValue k s a
KeyValue ((Maybe s, k, Maybe s) -> NonEmpty (Maybe s, k, Maybe s)
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 :: Map Text (RecordField Src a) -> Doc Ann
prettyRecordLit Map Text (RecordField Src a)
m
        | [ (Text
"date"    , RecordField Src a -> Expr Src a
forall s a. RecordField s a -> Expr s a
field -> d :: Expr Src a
d@DateLiteral{})
          , (Text
"time"    , RecordField Src a -> Expr Src a
forall s a. RecordField s a -> Expr s a
field -> t :: Expr Src a
t@TimeLiteral{})
          , (Text
"timeZone", RecordField Src a -> Expr Src a
forall s a. RecordField s a -> Expr s a
field -> z :: Expr Src a
z@TimeZoneLiteral{})
          ] <- ((Text, RecordField Src a) -> Text)
-> [(Text, RecordField Src a)] -> [(Text, RecordField Src a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Text, RecordField Src a) -> Text
forall a b. (a, b) -> a
fst (Map Text (RecordField Src a) -> [(Text, RecordField Src a)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField Src a)
m) =
              Doc Ann -> Doc Ann
literal
                  (   Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
d
                  Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"T"
                  Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
t
                  Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
z
                  )
        | [ (Text
"date"    , RecordField Src a -> Expr Src a
forall s a. RecordField s a -> Expr s a
field -> d :: Expr Src a
d@DateLiteral{})
          , (Text
"time"    , RecordField Src a -> Expr Src a
forall s a. RecordField s a -> Expr s a
field -> t :: Expr Src a
t@TimeLiteral{})
          ] <- ((Text, RecordField Src a) -> Text)
-> [(Text, RecordField Src a)] -> [(Text, RecordField Src a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Text, RecordField Src a) -> Text
forall a b. (a, b) -> a
fst (Map Text (RecordField Src a) -> [(Text, RecordField Src a)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField Src a)
m) =
              Doc Ann -> Doc Ann
literal
                  (   Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
d
                  Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"T"
                  Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
t
                  )
        | [ (Text
"time"    , RecordField Src a -> Expr Src a
forall s a. RecordField s a -> Expr s a
field -> t :: Expr Src a
t@TimeLiteral{})
          , (Text
"timeZone", RecordField Src a -> Expr Src a
forall s a. RecordField s a -> Expr s a
field -> z :: Expr Src a
z@TimeZoneLiteral{})
          ] <- ((Text, RecordField Src a) -> Text)
-> [(Text, RecordField Src a)] -> [(Text, RecordField Src a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Text, RecordField Src a) -> Text
forall a b. (a, b) -> a
fst (Map Text (RecordField Src a) -> [(Text, RecordField Src a)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField Src a)
m) =
              Doc Ann -> Doc Ann
literal
                  (   Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
t
                  Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyPrimitiveExpression Expr Src a
z
                  )
      where
        field :: RecordField s a -> Expr s a
field = Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Dhall.Syntax.shallowDenote (Expr s a -> Expr s a)
-> (RecordField s a -> Expr s a) -> RecordField s a -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
recordFieldValue
    prettyRecordLit Map Text (RecordField Src a)
m = ([(Doc Ann, Doc Ann)] -> Doc Ann)
-> Map Text (RecordField Src a) -> Doc Ann
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 :: Int -> Map Text (RecordField Src a) -> Doc Ann
prettyCompletionLit = ([(Doc Ann, Doc Ann)] -> Doc Ann)
-> Map Text (RecordField Src a) -> Doc Ann
forall a.
Pretty a =>
([(Doc Ann, Doc Ann)] -> Doc Ann)
-> Map Text (RecordField Src a) -> Doc Ann
prettyRecordLike (([(Doc Ann, Doc Ann)] -> Doc Ann)
 -> Map Text (RecordField Src a) -> Doc Ann)
-> (Int -> [(Doc Ann, Doc Ann)] -> Doc Ann)
-> Int
-> Map Text (RecordField Src a)
-> Doc Ann
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 :: ([(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
        | Map Text (RecordField Src a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Data.Foldable.null Map Text (RecordField Src a)
a =
            Doc Ann
lbrace Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
equals Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
rbrace
        | Bool
otherwise =
            [(Doc Ann, Doc Ann)] -> Doc Ann
braceStyle ((KeyValue Text Src a -> (Doc Ann, Doc Ann))
-> [KeyValue Text Src a] -> [(Doc Ann, Doc Ann)]
forall a b. (a -> b) -> [a] -> [b]
map KeyValue Text Src a -> (Doc Ann, Doc Ann)
forall a. Pretty a => KeyValue Text Src a -> (Doc Ann, Doc Ann)
prettyRecordEntry (Map Text (RecordField Src a) -> [KeyValue Text Src a]
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) <- Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a
Dhall.Syntax.shallowDenote Expr Src a
val
                    , Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
key'
                    , Bool -> Bool
not (Maybe Src -> Bool
containsComment Maybe Src
mSrc2) ->
                        Doc Ann -> (Doc Ann, Doc Ann)
forall a. a -> (a, a)
duplicate ((Text -> Doc Ann) -> [(Maybe Src, Text, Maybe Src)] -> Doc Ann
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)
_ ->
                    (Text -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> KeyValue Text Src a
-> (Doc Ann, 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 Text -> Doc Ann
prettyAnyLabel Expr Src a -> Doc Ann
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) =
        (Text -> Doc Ann)
-> (Expr Src a -> Doc Ann)
-> Doc Ann
-> KeyValue Text Src a
-> (Doc Ann, 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 Text -> Doc Ann
prettyAnyLabel Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettyExpression Doc Ann
colon (NonEmpty Text -> Expr Src a -> KeyValue Text Src a
forall key s a. NonEmpty key -> Expr s a -> KeyValue key s a
makeKeyValue (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
key) Expr Src a
val)
    prettyAlternative (Text
key, Maybe (Expr Src a)
Nothing) =
        Doc Ann -> (Doc Ann, Doc Ann)
forall a. a -> (a, a)
duplicate (Text -> Doc Ann
prettyAnyLabel Text
key)

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

-- | Escape @'${@ correctly
--
-- See: https://github.com/dhall-lang/dhall-haskell/issues/2078
escapeSingleQuoteBeforeInterpolation :: Chunks s a -> Chunks s a
escapeSingleQuoteBeforeInterpolation :: Chunks s a -> Chunks s a
escapeSingleQuoteBeforeInterpolation = (Text -> Chunks s a) -> Chunks s a -> Chunks s a
forall s a. (Text -> Chunks s a) -> Chunks s a -> Chunks s a
splitWith Text -> Chunks s a
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…
            []     -> Chunks s a
forall a. Monoid a => a
mempty
            Text
t : [Text]
ts -> Text -> [Text] -> Chunks s a
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
            [] ->
                [(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
head_
            Text
newHead : [Text]
newTail ->
                    [(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [ (Text
head_, Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
"'")) ] Text
"${"
                Chunks s a -> Chunks s a -> Chunks s a
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 :: (Text -> Chunks s a) -> Chunks s a -> Chunks s a
splitWith Text -> Chunks s a
splitter (Chunks [(Text, Expr s a)]
xys Text
z) = [Chunks s a] -> Chunks s a
forall a. Monoid a => [a] -> a
mconcat ([Chunks s a]
xys' [Chunks s a] -> [Chunks s a] -> [Chunks s a]
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, [(Text, Expr s a)] -> Text -> Chunks s a
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 :: (Char -> Bool) -> Text -> Chunks s a
splitOnPredicate Char -> Bool
predicate Text
text
    | Text -> Bool
Text.null Text
b =
        [(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
a
    | Bool
otherwise =
        [(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks ((Text
a, Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
c)) (Text, Expr s a) -> [(Text, Expr s a)] -> [(Text, Expr s a)]
forall a. a -> [a] -> [a]
: [(Text, Expr s 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 = (Char -> Bool) -> Text -> Chunks s a
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 :: Chunks s a -> Chunks s a
escapeTrailingSingleQuote chunks :: Chunks s a
chunks@(Chunks [(Text, Expr s a)]
as Text
b) =
    case Text -> Maybe (Text, Char)
Text.unsnoc Text
b of
        Just (Text
b', Char
'\'') -> [(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks ([(Text, Expr s a)]
as [(Text, Expr s a)] -> [(Text, Expr s a)] -> [(Text, Expr s a)]
forall a. [a] -> [a] -> [a]
++ [(Text
b', Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
"'"))]) Text
""
        Maybe (Text, Char)
_               -> Chunks s a
chunks

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

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

makeKeyValue :: NonEmpty key -> Expr s a -> KeyValue key s a
makeKeyValue :: NonEmpty key -> Expr s a -> KeyValue key s a
makeKeyValue NonEmpty key
keys Expr s a
expr = NonEmpty (Maybe s, key, Maybe s)
-> Maybe s -> Expr s a -> KeyValue key s a
forall k s a.
NonEmpty (Maybe s, k, Maybe s)
-> Maybe s -> Expr s a -> KeyValue k s a
KeyValue (key -> (Maybe s, key, Maybe s)
forall b a a. b -> (Maybe a, b, Maybe a)
adapt (key -> (Maybe s, key, Maybe s))
-> NonEmpty key -> NonEmpty (Maybe s, key, Maybe s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty key
keys) Maybe s
forall a. Maybe a
Nothing Expr s a
expr
  where
    adapt :: b -> (Maybe a, b, Maybe a)
adapt b
key = (Maybe a
forall a. Maybe a
Nothing, b
key, Maybe a
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 :: Map Text (RecordField Src a) -> [KeyValue Text Src a]
consolidateRecordLiteral = ((Text, RecordField Src a) -> [KeyValue Text Src a])
-> [(Text, RecordField Src a)] -> [KeyValue Text Src a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, RecordField Src a) -> [KeyValue Text Src a]
forall a. (Text, RecordField Src a) -> [KeyValue Text Src a]
adapt ([(Text, RecordField Src a)] -> [KeyValue Text Src a])
-> (Map Text (RecordField Src a) -> [(Text, RecordField Src a)])
-> Map Text (RecordField Src a)
-> [KeyValue Text Src a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text (RecordField Src a) -> [(Text, RecordField Src a)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList
  where
    adapt :: (Text, RecordField Src a) -> [KeyValue Text Src a]
    adapt :: (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' ] <- ((Text, RecordField Src a) -> [KeyValue Text Src a])
-> [(Text, RecordField Src a)] -> [KeyValue Text Src a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, RecordField Src a) -> [KeyValue Text Src a]
forall a. (Text, RecordField Src a) -> [KeyValue Text Src a]
adapt (Map Text (RecordField Src a) -> [(Text, RecordField Src a)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField Src a)
m) =
            [ NonEmpty (Maybe Src, Text, Maybe Src)
-> Maybe Src -> Expr Src a -> KeyValue Text Src a
forall k s a.
NonEmpty (Maybe s, k, Maybe s)
-> Maybe s -> Expr s a -> KeyValue k s a
KeyValue ((Maybe Src, Text, Maybe Src)
-> NonEmpty (Maybe Src, Text, Maybe Src)
-> NonEmpty (Maybe Src, Text, Maybe Src)
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 =
            (Text, RecordField Src a) -> [KeyValue Text Src a]
forall a. (Text, RecordField Src a) -> [KeyValue Text Src a]
adapt (Text
key, Expr Src a -> RecordField Src a
forall s a. Expr s a -> RecordField s a
makeRecordField Expr Src a
l) [KeyValue Text Src a]
-> [KeyValue Text Src a] -> [KeyValue Text Src a]
forall a. Semigroup a => a -> a -> a
<> (Text, RecordField Src a) -> [KeyValue Text Src a]
forall a. (Text, RecordField Src a) -> [KeyValue Text Src a]
adapt (Text
key, Expr Src a -> RecordField Src a
forall s a. Expr s a -> RecordField s a
makeRecordField Expr Src a
r)
        | Bool
otherwise =
            [ NonEmpty (Maybe Src, Text, Maybe Src)
-> Maybe Src -> Expr Src a -> KeyValue Text Src a
forall k s a.
NonEmpty (Maybe s, k, Maybe s)
-> Maybe s -> Expr s a -> KeyValue k s a
KeyValue ((Maybe Src, Text, Maybe Src)
-> NonEmpty (Maybe Src, Text, Maybe Src)
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 = Expr Src a -> Expr Src a
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 :: Chunks s a -> Chunks s a
escapeSingleQuotedText = (Text -> Chunks s a) -> Chunks s a -> Chunks s a
forall s a. (Text -> Chunks s a) -> Chunks s a -> Chunks s a
splitWith Text -> Chunks s a
forall s a. Text -> Chunks s a
f
  where
    f :: Text -> Chunks s a
f Text
inputText = [(Text, Expr s a)] -> Text -> Chunks s a
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' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x21'     = Char -> Text
Text.singleton Char
c
        -- '\x22' == '"'
        | Char
'\x23' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c                    = Char -> Text
Text.singleton Char
c
        -- '\x24' == '$'
        | Char
'\x25' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x5B'     = Char -> Text
Text.singleton Char
c
        -- '\x5C' == '\\'
        | Char
'\x5D' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x10FFFF' = Char -> Text
Text.singleton Char
c
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"'                       = Text
"\\\""
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$'                       = Text
"\\$"
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\'                      = Text
"\\\\"
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\b'                      = Text
"\\b"
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\f'                      = Text
"\\f"
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'                      = Text
"\\n"
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r'                      = Text
"\\r"
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'                      = Text
"\\t"
        | Bool
otherwise                      = Text
"\\u" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
showDigits (Char -> Int
Data.Char.ord Char
c)

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

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

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

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

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

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

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

{-| 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 :: 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"    , RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
field -> DateLiteral{})
          , (Text
"time"    , RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
field -> TimeLiteral{})
          , (Text
"timeZone", RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
field -> TimeZoneLiteral{})
          ] <- ((Text, RecordField s a) -> Text)
-> [(Text, RecordField s a)] -> [(Text, RecordField s a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Text, RecordField s a) -> Text
forall a b. (a, b) -> a
fst (Map Text (RecordField s a) -> [(Text, RecordField s a)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField s a)
m) -> Maybe Text
rendered
        | [ (Text
"date"    , RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
field -> DateLiteral{})
          , (Text
"time"    , RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
field -> TimeLiteral{})
          ] <- ((Text, RecordField s a) -> Text)
-> [(Text, RecordField s a)] -> [(Text, RecordField s a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Text, RecordField s a) -> Text
forall a b. (a, b) -> a
fst (Map Text (RecordField s a) -> [(Text, RecordField s a)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField s a)
m) -> Maybe Text
rendered
        | [ (Text
"time"    , RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
field -> TimeLiteral{})
          , (Text
"timeZone", RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
field -> TimeZoneLiteral{})
          ] <- ((Text, RecordField s a) -> Text)
-> [(Text, RecordField s a)] -> [(Text, RecordField s a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Text, RecordField s a) -> Text
forall a b. (a, b) -> a
fst (Map Text (RecordField s a) -> [(Text, RecordField s a)]
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
_ -> Maybe Text
forall a. Maybe a
Nothing
  where
    field :: RecordField s a -> Expr s a
field = Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Dhall.Syntax.shallowDenote (Expr s a -> Expr s a)
-> (RecordField s a -> Expr s a) -> RecordField s a -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
recordFieldValue

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

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