{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall #-}
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
data Ann
= Keyword
| Syntax
| Label
| Literal
| Builtin
| Operator
deriving Int -> Ann -> ShowS
[Ann] -> ShowS
Ann -> String
(Int -> Ann -> ShowS)
-> (Ann -> String) -> ([Ann] -> ShowS) -> Show Ann
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ann] -> ShowS
$cshowList :: [Ann] -> ShowS
show :: Ann -> String
$cshow :: Ann -> String
showsPrec :: Int -> Ann -> ShowS
$cshowsPrec :: Int -> Ann -> ShowS
Show
annToAnsiStyle :: Ann -> Terminal.AnsiStyle
annToAnsiStyle :: Ann -> AnsiStyle
annToAnsiStyle 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
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)
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
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
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
prettyExpr :: Pretty a => Expr s a -> Doc Ann
prettyExpr :: Expr s a -> Doc Ann
prettyExpr = Expr Src a -> Doc Ann
forall a. Pretty a => Expr Src a -> Doc Ann
prettySrcExpr (Expr Src a -> Doc Ann)
-> (Expr s a -> Expr Src a) -> Expr s a -> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr s a -> Expr Src a
forall s a t. Expr s a -> Expr t a
denote
prettySrcExpr :: Pretty a => Expr Src a -> Doc Ann
prettySrcExpr :: Expr Src a -> Doc Ann
prettySrcExpr = CharacterSet -> Expr Src a -> Doc Ann
forall a. Pretty a => CharacterSet -> Expr Src a -> Doc Ann
prettyCharacterSet CharacterSet
Unicode
duplicate :: a -> (a, a)
duplicate :: a -> (a, a)
duplicate 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
renderSrc
:: (Text -> Text)
-> Maybe Src
-> 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
renderComment :: Text -> Doc Ann
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
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 :: Maybe Src -> Bool
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)
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
"::"
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)
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
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
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
"≡"
enclose
:: Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> [(Doc ann, Doc ann)]
-> Doc ann
enclose :: Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> [(Doc ann, Doc ann)]
-> Doc ann
enclose 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
enclose'
:: Doc ann
-> Doc ann
-> Doc ann
-> Doc ann
-> [(Doc ann, Doc ann)]
-> Doc ann
enclose' :: Doc ann
-> Doc ann -> Doc ann -> Doc ann -> [(Doc ann, Doc ann)] -> Doc ann
enclose' 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
'/'
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
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'
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
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"
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{} ->
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 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
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))
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
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₀
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'
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
[] -> 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
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
"" ]
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
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_ :: 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)
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
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)