-- |
-- Pretty printer for values
--
module Language.PureScript.Pretty.Values
  ( prettyPrintValue
  , prettyPrintBinder
  , prettyPrintBinderAtom
  ) where

import Prelude hiding ((<>))

import Control.Arrow (second)

import Data.Text (Text)
import Data.List.NonEmpty qualified as NEL
import Data.Monoid qualified as Monoid ((<>))
import Data.Text qualified as T

import Language.PureScript.AST (AssocList(..), Binder(..), CaseAlternative(..), Declaration(..), DoNotationElement(..), Expr(..), Guard(..), GuardedExpr(..), Literal(..), PathNode(..), PathTree(..), TypeDeclarationData(..), pattern ValueDecl, WhereProvenance(..))
import Language.PureScript.Crash (internalError)
import Language.PureScript.Names (OpName(..), ProperName(..), Qualified(..), disqualify, runModuleName, showIdent)
import Language.PureScript.Pretty.Common (before, beforeWithSpace, parensT)
import Language.PureScript.Pretty.Types (typeAsBox, typeAtomAsBox, prettyPrintObjectKey)
import Language.PureScript.Types (Constraint(..))
import Language.PureScript.PSString (PSString, prettyPrintString)

import Text.PrettyPrint.Boxes (Box, left, moveRight, text, vcat, vsep, (//), (<>))

-- TODO(Christoph): remove T.unpack s

textT :: Text -> Box
textT :: Text -> Box
textT = [Char] -> Box
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

-- | Render an aligned list of items separated with commas
list :: Char -> Char -> (a -> Box) -> [a] -> Box
list :: forall a. Char -> Char -> (a -> Box) -> [a] -> Box
list Char
open Char
close a -> Box
_ [] = [Char] -> Box
text [Char
open, Char
close]
list Char
open Char
close a -> Box
f [a]
xs = forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
left (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> a -> Box
toLine [Int
0 :: Int ..] [a]
xs forall a. [a] -> [a] -> [a]
++ [ [Char] -> Box
text [ Char
close ] ])
  where
  toLine :: Int -> a -> Box
toLine Int
i a
a = [Char] -> Box
text [ if Int
i forall a. Eq a => a -> a -> Bool
== Int
0 then Char
open else Char
',', Char
' ' ] Box -> Box -> Box
<> a -> Box
f a
a

ellipsis :: Box
ellipsis :: Box
ellipsis = [Char] -> Box
text [Char]
"..."

prettyPrintObject :: Int -> [(PSString, Maybe Expr)] -> Box
prettyPrintObject :: Int -> [(PSString, Maybe Expr)] -> Box
prettyPrintObject Int
d = forall a. Char -> Char -> (a -> Box) -> [a] -> Box
list Char
'{' Char
'}' (PSString, Maybe Expr) -> Box
prettyPrintObjectProperty
  where
  prettyPrintObjectProperty :: (PSString, Maybe Expr) -> Box
  prettyPrintObjectProperty :: (PSString, Maybe Expr) -> Box
prettyPrintObjectProperty (PSString
key, Maybe Expr
value) = Text -> Box
textT (PSString -> Text
prettyPrintObjectKey PSString
key forall a. Semigroup a => a -> a -> a
Monoid.<> Text
": ") Box -> Box -> Box
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Box
text [Char]
"_") (Int -> Expr -> Box
prettyPrintValue (Int
d forall a. Num a => a -> a -> a
- Int
1)) Maybe Expr
value

prettyPrintUpdateEntry :: Int -> PSString -> Expr -> Box
prettyPrintUpdateEntry :: Int -> PSString -> Expr -> Box
prettyPrintUpdateEntry Int
d PSString
key Expr
val = Text -> Box
textT (PSString -> Text
prettyPrintObjectKey PSString
key) Box -> Box -> Box
<> [Char] -> Box
text [Char]
" = " Box -> Box -> Box
<> Int -> Expr -> Box
prettyPrintValue (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
val

-- | Pretty-print an expression
prettyPrintValue :: Int -> Expr -> Box
prettyPrintValue :: Int -> Expr -> Box
prettyPrintValue Int
d Expr
_ | Int
d forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> Box
text [Char]
"..."
prettyPrintValue Int
d (IfThenElse Expr
cond Expr
th Expr
el) =
  ([Char] -> Box
text [Char]
"if " Box -> Box -> Box
<> Int -> Expr -> Box
prettyPrintValueAtom (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
cond)
  Box -> Box -> Box
// Int -> Box -> Box
moveRight Int
2 (forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
left [ [Char] -> Box
text [Char]
"then " Box -> Box -> Box
<> Int -> Expr -> Box
prettyPrintValueAtom (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
th
                            , [Char] -> Box
text [Char]
"else " Box -> Box -> Box
<> Int -> Expr -> Box
prettyPrintValueAtom (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
el
                            ])
prettyPrintValue Int
d (Accessor PSString
prop Expr
val) = Int -> Expr -> Box
prettyPrintValueAtom (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
val Box -> Box -> Box
`before` Text -> Box
textT (Text
"." forall a. Semigroup a => a -> a -> a
Monoid.<> PSString -> Text
prettyPrintObjectKey PSString
prop)
prettyPrintValue Int
d (ObjectUpdate Expr
o [(PSString, Expr)]
ps) = Int -> Expr -> Box
prettyPrintValueAtom (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
o Box -> Box -> Box
`beforeWithSpace` forall a. Char -> Char -> (a -> Box) -> [a] -> Box
list Char
'{' Char
'}' (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> PSString -> Expr -> Box
prettyPrintUpdateEntry Int
d)) [(PSString, Expr)]
ps
prettyPrintValue Int
d (ObjectUpdateNested Expr
o PathTree Expr
ps) = Int -> Expr -> Box
prettyPrintValueAtom (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
o Box -> Box -> Box
`beforeWithSpace` PathTree Expr -> Box
prettyPrintUpdate PathTree Expr
ps
  where
    prettyPrintUpdate :: PathTree Expr -> Box
prettyPrintUpdate (PathTree AssocList PSString (PathNode Expr)
tree) = forall a. Char -> Char -> (a -> Box) -> [a] -> Box
list Char
'{' Char
'}' (PSString, PathNode Expr) -> Box
printNode (forall k t. AssocList k t -> [(k, t)]
runAssocList AssocList PSString (PathNode Expr)
tree)
    printNode :: (PSString, PathNode Expr) -> Box
printNode (PSString
key, Leaf Expr
val) = Int -> PSString -> Expr -> Box
prettyPrintUpdateEntry Int
d PSString
key Expr
val
    printNode (PSString
key, Branch PathTree Expr
val) = Text -> Box
textT (PSString -> Text
prettyPrintObjectKey PSString
key) Box -> Box -> Box
`beforeWithSpace` PathTree Expr -> Box
prettyPrintUpdate PathTree Expr
val
prettyPrintValue Int
d (App Expr
val Expr
arg) = Int -> Expr -> Box
prettyPrintValueAtom (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
val Box -> Box -> Box
`beforeWithSpace` Int -> Expr -> Box
prettyPrintValueAtom (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
arg
prettyPrintValue Int
d (Unused Expr
val) = Int -> Expr -> Box
prettyPrintValue Int
d Expr
val
prettyPrintValue Int
d (Abs Binder
arg Expr
val) = [Char] -> Box
text (Char
'\\' forall a. a -> [a] -> [a]
: Text -> [Char]
T.unpack (Binder -> Text
prettyPrintBinder Binder
arg) forall a. [a] -> [a] -> [a]
++ [Char]
" -> ") Box -> Box -> Box
// Int -> Box -> Box
moveRight Int
2 (Int -> Expr -> Box
prettyPrintValue (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
val)
prettyPrintValue Int
d (Case [Expr]
values [CaseAlternative]
binders) =
  ([Char] -> Box
text [Char]
"case " Box -> Box -> Box
<> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Box -> Box -> Box
beforeWithSpace ([Char] -> Box
text [Char]
"of") (forall a b. (a -> b) -> [a] -> [b]
map (Int -> Expr -> Box
prettyPrintValueAtom (Int
d forall a. Num a => a -> a -> a
- Int
1)) [Expr]
values)) Box -> Box -> Box
//
    Int -> Box -> Box
moveRight Int
2 (forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
left (forall a b. (a -> b) -> [a] -> [b]
map (Int -> CaseAlternative -> Box
prettyPrintCaseAlternative (Int
d forall a. Num a => a -> a -> a
- Int
1)) [CaseAlternative]
binders))
prettyPrintValue Int
d (Let WhereProvenance
FromWhere [Declaration]
ds Expr
val) =
  Int -> Expr -> Box
prettyPrintValue (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
val Box -> Box -> Box
//
    Int -> Box -> Box
moveRight Int
2 ([Char] -> Box
text [Char]
"where" Box -> Box -> Box
//
                 forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
left (forall a b. (a -> b) -> [a] -> [b]
map (Int -> Declaration -> Box
prettyPrintDeclaration (Int
d forall a. Num a => a -> a -> a
- Int
1)) [Declaration]
ds))
prettyPrintValue Int
d (Let WhereProvenance
FromLet [Declaration]
ds Expr
val) =
  [Char] -> Box
text [Char]
"let" Box -> Box -> Box
//
    Int -> Box -> Box
moveRight Int
2 (forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
left (forall a b. (a -> b) -> [a] -> [b]
map (Int -> Declaration -> Box
prettyPrintDeclaration (Int
d forall a. Num a => a -> a -> a
- Int
1)) [Declaration]
ds)) Box -> Box -> Box
//
    ([Char] -> Box
text [Char]
"in " Box -> Box -> Box
<> Int -> Expr -> Box
prettyPrintValue (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
val)
prettyPrintValue Int
d (Do Maybe ModuleName
m [DoNotationElement]
els) =
  Text -> Box
textT (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((forall a. Semigroup a => a -> a -> a
Monoid.<> Text
".") forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
runModuleName) Maybe ModuleName
m) Box -> Box -> Box
<> [Char] -> Box
text [Char]
"do " Box -> Box -> Box
<> forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
left (forall a b. (a -> b) -> [a] -> [b]
map (Int -> DoNotationElement -> Box
prettyPrintDoNotationElement (Int
d forall a. Num a => a -> a -> a
- Int
1)) [DoNotationElement]
els)
prettyPrintValue Int
d (Ado Maybe ModuleName
m [DoNotationElement]
els Expr
yield) =
  Text -> Box
textT (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((forall a. Semigroup a => a -> a -> a
Monoid.<> Text
".") forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
runModuleName) Maybe ModuleName
m) Box -> Box -> Box
<> [Char] -> Box
text [Char]
"ado " Box -> Box -> Box
<> forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
left (forall a b. (a -> b) -> [a] -> [b]
map (Int -> DoNotationElement -> Box
prettyPrintDoNotationElement (Int
d forall a. Num a => a -> a -> a
- Int
1)) [DoNotationElement]
els) Box -> Box -> Box
//
  ([Char] -> Box
text [Char]
"in " Box -> Box -> Box
<> Int -> Expr -> Box
prettyPrintValue (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
yield)
-- TODO: constraint kind args
prettyPrintValue Int
d (TypeClassDictionary (Constraint SourceAnn
_ Qualified (ProperName 'ClassName)
name [Type SourceAnn]
_ [Type SourceAnn]
tys Maybe ConstraintData
_) Map
  QualifiedBy
  (Map
     (Qualified (ProperName 'ClassName))
     (Map (Qualified Ident) (NonEmpty NamedDict)))
_ [ErrorMessageHint]
_) = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Box -> Box -> Box
beforeWithSpace forall a b. (a -> b) -> a -> b
$ [Char] -> Box
text ([Char]
"#dict " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (forall (a :: ProperNameType). ProperName a -> Text
runProperName (forall a. Qualified a -> a
disqualify Qualified (ProperName 'ClassName)
name))) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> Type a -> Box
typeAtomAsBox Int
d) [Type SourceAnn]
tys
prettyPrintValue Int
_ (DeferredDictionary Qualified (ProperName 'ClassName)
name [Type SourceAnn]
_) = [Char] -> Box
text forall a b. (a -> b) -> a -> b
$ [Char]
"#dict " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (forall (a :: ProperNameType). ProperName a -> Text
runProperName (forall a. Qualified a -> a
disqualify Qualified (ProperName 'ClassName)
name))
prettyPrintValue Int
_ (DerivedInstancePlaceholder Qualified (ProperName 'ClassName)
name InstanceDerivationStrategy
_) = [Char] -> Box
text forall a b. (a -> b) -> a -> b
$ [Char]
"#derived " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (forall (a :: ProperNameType). ProperName a -> Text
runProperName (forall a. Qualified a -> a
disqualify Qualified (ProperName 'ClassName)
name))
prettyPrintValue Int
d (TypedValue Bool
_ Expr
val Type SourceAnn
_) = Int -> Expr -> Box
prettyPrintValue Int
d Expr
val
prettyPrintValue Int
d (PositionedValue SourceSpan
_ [Comment]
_ Expr
val) = Int -> Expr -> Box
prettyPrintValue Int
d Expr
val
prettyPrintValue Int
d (Literal SourceSpan
_ Literal Expr
l) = Int -> Literal Expr -> Box
prettyPrintLiteralValue Int
d Literal Expr
l
prettyPrintValue Int
_ (Hole Text
name) = [Char] -> Box
text [Char]
"?" Box -> Box -> Box
<> Text -> Box
textT Text
name
prettyPrintValue Int
d expr :: Expr
expr@AnonymousArgument{} = Int -> Expr -> Box
prettyPrintValueAtom Int
d Expr
expr
prettyPrintValue Int
d expr :: Expr
expr@Constructor{} = Int -> Expr -> Box
prettyPrintValueAtom Int
d Expr
expr
prettyPrintValue Int
d expr :: Expr
expr@Var{} = Int -> Expr -> Box
prettyPrintValueAtom Int
d Expr
expr
prettyPrintValue Int
d expr :: Expr
expr@Op{} = Int -> Expr -> Box
prettyPrintValueAtom Int
d Expr
expr
prettyPrintValue Int
d expr :: Expr
expr@BinaryNoParens{} = Int -> Expr -> Box
prettyPrintValueAtom Int
d Expr
expr
prettyPrintValue Int
d expr :: Expr
expr@Parens{} = Int -> Expr -> Box
prettyPrintValueAtom Int
d Expr
expr
prettyPrintValue Int
d expr :: Expr
expr@UnaryMinus{} = Int -> Expr -> Box
prettyPrintValueAtom Int
d Expr
expr

-- | Pretty-print an atomic expression, adding parentheses if necessary.
prettyPrintValueAtom :: Int -> Expr -> Box
prettyPrintValueAtom :: Int -> Expr -> Box
prettyPrintValueAtom Int
d (Literal SourceSpan
_ Literal Expr
l) = Int -> Literal Expr -> Box
prettyPrintLiteralValue Int
d Literal Expr
l
prettyPrintValueAtom Int
_ Expr
AnonymousArgument = [Char] -> Box
text [Char]
"_"
prettyPrintValueAtom Int
_ (Constructor SourceSpan
_ Qualified (ProperName 'ConstructorName)
name) = [Char] -> Box
text forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall (a :: ProperNameType). ProperName a -> Text
runProperName (forall a. Qualified a -> a
disqualify Qualified (ProperName 'ConstructorName)
name)
prettyPrintValueAtom Int
_ (Var SourceSpan
_ Qualified Ident
ident) = [Char] -> Box
text forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ Ident -> Text
showIdent (forall a. Qualified a -> a
disqualify Qualified Ident
ident)
prettyPrintValueAtom Int
d (BinaryNoParens Expr
op Expr
lhs Expr
rhs) =
  Int -> Expr -> Box
prettyPrintValue (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
lhs Box -> Box -> Box
`beforeWithSpace` Expr -> Box
printOp Expr
op Box -> Box -> Box
`beforeWithSpace` Int -> Expr -> Box
prettyPrintValue (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
rhs
  where
  printOp :: Expr -> Box
printOp (Op SourceSpan
_ (Qualified QualifiedBy
_ OpName 'ValueOpName
name)) = [Char] -> Box
text forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall (a :: OpNameType). OpName a -> Text
runOpName OpName 'ValueOpName
name
  printOp Expr
expr = [Char] -> Box
text [Char]
"`" Box -> Box -> Box
<> Int -> Expr -> Box
prettyPrintValue (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
expr Box -> Box -> Box
`before` [Char] -> Box
text [Char]
"`"
prettyPrintValueAtom Int
d (TypedValue Bool
_ Expr
val Type SourceAnn
_) = Int -> Expr -> Box
prettyPrintValueAtom Int
d Expr
val
prettyPrintValueAtom Int
d (PositionedValue SourceSpan
_ [Comment]
_ Expr
val) = Int -> Expr -> Box
prettyPrintValueAtom Int
d Expr
val
prettyPrintValueAtom Int
d (Parens Expr
expr) = ([Char] -> Box
text [Char]
"(" Box -> Box -> Box
<> Int -> Expr -> Box
prettyPrintValue Int
d Expr
expr) Box -> Box -> Box
`before` [Char] -> Box
text [Char]
")"
prettyPrintValueAtom Int
d (UnaryMinus SourceSpan
_ Expr
expr) = [Char] -> Box
text [Char]
"(-" Box -> Box -> Box
<> Int -> Expr -> Box
prettyPrintValue Int
d Expr
expr Box -> Box -> Box
<> [Char] -> Box
text [Char]
")"
prettyPrintValueAtom Int
d Expr
expr = ([Char] -> Box
text [Char]
"(" Box -> Box -> Box
<> Int -> Expr -> Box
prettyPrintValue Int
d Expr
expr) Box -> Box -> Box
`before` [Char] -> Box
text [Char]
")"

prettyPrintLiteralValue :: Int -> Literal Expr -> Box
prettyPrintLiteralValue :: Int -> Literal Expr -> Box
prettyPrintLiteralValue Int
_ (NumericLiteral Either Integer Double
n) = [Char] -> Box
text forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Show a => a -> [Char]
show forall a. Show a => a -> [Char]
show Either Integer Double
n
prettyPrintLiteralValue Int
_ (StringLiteral PSString
s) = [Char] -> Box
text forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ PSString -> Text
prettyPrintString PSString
s
prettyPrintLiteralValue Int
_ (CharLiteral Char
c) = [Char] -> Box
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Char
c
prettyPrintLiteralValue Int
_ (BooleanLiteral Bool
True) = [Char] -> Box
text [Char]
"true"
prettyPrintLiteralValue Int
_ (BooleanLiteral Bool
False) = [Char] -> Box
text [Char]
"false"
prettyPrintLiteralValue Int
d (ArrayLiteral [Expr]
xs) = forall a. Char -> Char -> (a -> Box) -> [a] -> Box
list Char
'[' Char
']' (Int -> Expr -> Box
prettyPrintValue (Int
d forall a. Num a => a -> a -> a
- Int
1)) [Expr]
xs
prettyPrintLiteralValue Int
d (ObjectLiteral [(PSString, Expr)]
ps) = Int -> [(PSString, Maybe Expr)] -> Box
prettyPrintObject (Int
d forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. a -> Maybe a
Just forall a b. (a -> b) -> [a] -> [b]
`map` [(PSString, Expr)]
ps

prettyPrintDeclaration :: Int -> Declaration -> Box
prettyPrintDeclaration :: Int -> Declaration -> Box
prettyPrintDeclaration Int
d Declaration
_ | Int
d forall a. Ord a => a -> a -> Bool
< Int
0 = Box
ellipsis
prettyPrintDeclaration Int
d (TypeDeclaration TypeDeclarationData
td) =
  [Char] -> Box
text (Text -> [Char]
T.unpack (Ident -> Text
showIdent (TypeDeclarationData -> Ident
tydeclIdent TypeDeclarationData
td)) forall a. [a] -> [a] -> [a]
++ [Char]
" :: ") Box -> Box -> Box
<> forall a. Int -> Type a -> Box
typeAsBox Int
d (TypeDeclarationData -> Type SourceAnn
tydeclType TypeDeclarationData
td)
prettyPrintDeclaration Int
d (ValueDecl SourceAnn
_ Ident
ident NameKind
_ [] [GuardedExpr [] Expr
val]) =
  [Char] -> Box
text (Text -> [Char]
T.unpack (Ident -> Text
showIdent Ident
ident) forall a. [a] -> [a] -> [a]
++ [Char]
" = ") Box -> Box -> Box
<> Int -> Expr -> Box
prettyPrintValue (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
val
prettyPrintDeclaration Int
d (BindingGroupDeclaration NonEmpty ((SourceAnn, Ident), NameKind, Expr)
ds) =
  forall (f :: * -> *).
Foldable f =>
Int -> Alignment -> f Box -> Box
vsep Int
1 Alignment
left (forall a. NonEmpty a -> [a]
NEL.toList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Declaration -> Box
prettyPrintDeclaration (Int
d forall a. Num a => a -> a -> a
- Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SourceAnn, Ident), NameKind, Expr) -> Declaration
toDecl) NonEmpty ((SourceAnn, Ident), NameKind, Expr)
ds))
  where
  toDecl :: ((SourceAnn, Ident), NameKind, Expr) -> Declaration
toDecl ((SourceAnn
sa, Ident
nm), NameKind
t, Expr
e) = SourceAnn
-> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration
ValueDecl SourceAnn
sa Ident
nm NameKind
t [] [[Guard] -> Expr -> GuardedExpr
GuardedExpr [] Expr
e]
prettyPrintDeclaration Int
_ Declaration
_ = forall a. HasCallStack => [Char] -> a
internalError [Char]
"Invalid argument to prettyPrintDeclaration"

prettyPrintCaseAlternative :: Int -> CaseAlternative -> Box
prettyPrintCaseAlternative :: Int -> CaseAlternative -> Box
prettyPrintCaseAlternative Int
d CaseAlternative
_ | Int
d forall a. Ord a => a -> a -> Bool
< Int
0 = Box
ellipsis
prettyPrintCaseAlternative Int
d (CaseAlternative [Binder]
binders [GuardedExpr]
result) =
  [Char] -> Box
text (Text -> [Char]
T.unpack ([Text] -> Text
T.unwords (forall a b. (a -> b) -> [a] -> [b]
map Binder -> Text
prettyPrintBinderAtom [Binder]
binders))) Box -> Box -> Box
<> [GuardedExpr] -> Box
prettyPrintResult [GuardedExpr]
result
  where
  prettyPrintResult :: [GuardedExpr] -> Box
  prettyPrintResult :: [GuardedExpr] -> Box
prettyPrintResult [GuardedExpr [] Expr
v] = [Char] -> Box
text [Char]
" -> " Box -> Box -> Box
<> Int -> Expr -> Box
prettyPrintValue (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
v
  prettyPrintResult [GuardedExpr]
gs =
    forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
left (forall a b. (a -> b) -> [a] -> [b]
map (Box -> GuardedExpr -> Box
prettyPrintGuardedValueSep ([Char] -> Box
text [Char]
" | ")) [GuardedExpr]
gs)

  prettyPrintGuardedValueSep :: Box -> GuardedExpr -> Box
  prettyPrintGuardedValueSep :: Box -> GuardedExpr -> Box
prettyPrintGuardedValueSep Box
_ (GuardedExpr [] Expr
val) =
    [Char] -> Box
text [Char]
" -> " Box -> Box -> Box
<> Int -> Expr -> Box
prettyPrintValue (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
val

  prettyPrintGuardedValueSep Box
sep (GuardedExpr [Guard
guard] Expr
val) =
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Box -> Box -> Box
before [ Box
sep
                  , Guard -> Box
prettyPrintGuard Guard
guard
                  , Box -> GuardedExpr -> Box
prettyPrintGuardedValueSep Box
sep ([Guard] -> Expr -> GuardedExpr
GuardedExpr [] Expr
val)
                  ]

  prettyPrintGuardedValueSep Box
sep (GuardedExpr (Guard
guard : [Guard]
guards) Expr
val) =
    forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
left [ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Box -> Box -> Box
before
                [ Box
sep
                , Guard -> Box
prettyPrintGuard Guard
guard
                ]
              , Box -> GuardedExpr -> Box
prettyPrintGuardedValueSep ([Char] -> Box
text [Char]
" , ") ([Guard] -> Expr -> GuardedExpr
GuardedExpr [Guard]
guards Expr
val)
              ]

  prettyPrintGuard :: Guard -> Box
prettyPrintGuard (ConditionGuard Expr
cond) =
    Int -> Expr -> Box
prettyPrintValue (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
cond
  prettyPrintGuard (PatternGuard Binder
binder Expr
val) =
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Box -> Box -> Box
before
    [ [Char] -> Box
text (Text -> [Char]
T.unpack (Binder -> Text
prettyPrintBinder Binder
binder))
    , [Char] -> Box
text [Char]
" <- "
    , Int -> Expr -> Box
prettyPrintValue (Int
d forall a. Num a => a -> a -> a
- Int
1) Expr
val
    ]

prettyPrintDoNotationElement :: Int -> DoNotationElement -> Box
prettyPrintDoNotationElement :: Int -> DoNotationElement -> Box
prettyPrintDoNotationElement Int
d DoNotationElement
_ | Int
d forall a. Ord a => a -> a -> Bool
< Int
0 = Box
ellipsis
prettyPrintDoNotationElement Int
d (DoNotationValue Expr
val) =
  Int -> Expr -> Box
prettyPrintValue Int
d Expr
val
prettyPrintDoNotationElement Int
d (DoNotationBind Binder
binder Expr
val) =
  Text -> Box
textT (Binder -> Text
prettyPrintBinder Binder
binder forall a. Semigroup a => a -> a -> a
Monoid.<> Text
" <- ") Box -> Box -> Box
<> Int -> Expr -> Box
prettyPrintValue Int
d Expr
val
prettyPrintDoNotationElement Int
d (DoNotationLet [Declaration]
ds) =
  [Char] -> Box
text [Char]
"let" Box -> Box -> Box
//
    Int -> Box -> Box
moveRight Int
2 (forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
left (forall a b. (a -> b) -> [a] -> [b]
map (Int -> Declaration -> Box
prettyPrintDeclaration (Int
d forall a. Num a => a -> a -> a
- Int
1)) [Declaration]
ds))
prettyPrintDoNotationElement Int
d (PositionedDoNotationElement SourceSpan
_ [Comment]
_ DoNotationElement
el) = Int -> DoNotationElement -> Box
prettyPrintDoNotationElement Int
d DoNotationElement
el

prettyPrintBinderAtom :: Binder -> Text
prettyPrintBinderAtom :: Binder -> Text
prettyPrintBinderAtom Binder
NullBinder = Text
"_"
prettyPrintBinderAtom (LiteralBinder SourceSpan
_ Literal Binder
l) = Literal Binder -> Text
prettyPrintLiteralBinder Literal Binder
l
prettyPrintBinderAtom (VarBinder SourceSpan
_ Ident
ident) = Ident -> Text
showIdent Ident
ident
prettyPrintBinderAtom (ConstructorBinder SourceSpan
_ Qualified (ProperName 'ConstructorName)
ctor []) = forall (a :: ProperNameType). ProperName a -> Text
runProperName (forall a. Qualified a -> a
disqualify Qualified (ProperName 'ConstructorName)
ctor)
prettyPrintBinderAtom b :: Binder
b@ConstructorBinder{} = Text -> Text
parensT (Binder -> Text
prettyPrintBinder Binder
b)
prettyPrintBinderAtom (NamedBinder SourceSpan
_ Ident
ident Binder
binder) = Ident -> Text
showIdent Ident
ident forall a. Semigroup a => a -> a -> a
Monoid.<> Text
"@" forall a. Semigroup a => a -> a -> a
Monoid.<> Binder -> Text
prettyPrintBinder Binder
binder
prettyPrintBinderAtom (PositionedBinder SourceSpan
_ [Comment]
_ Binder
binder) = Binder -> Text
prettyPrintBinderAtom Binder
binder
prettyPrintBinderAtom (TypedBinder Type SourceAnn
_ Binder
binder) = Binder -> Text
prettyPrintBinderAtom Binder
binder
prettyPrintBinderAtom (OpBinder SourceSpan
_ Qualified (OpName 'ValueOpName)
op) = forall (a :: OpNameType). OpName a -> Text
runOpName (forall a. Qualified a -> a
disqualify Qualified (OpName 'ValueOpName)
op)
prettyPrintBinderAtom (BinaryNoParensBinder Binder
op Binder
b1 Binder
b2) =
  Binder -> Text
prettyPrintBinderAtom Binder
b1 forall a. Semigroup a => a -> a -> a
Monoid.<> Text
" " forall a. Semigroup a => a -> a -> a
Monoid.<> Binder -> Text
prettyPrintBinderAtom Binder
op forall a. Semigroup a => a -> a -> a
Monoid.<> Text
" " forall a. Semigroup a => a -> a -> a
Monoid.<> Binder -> Text
prettyPrintBinderAtom Binder
b2
prettyPrintBinderAtom (ParensInBinder Binder
b) = Text -> Text
parensT (Binder -> Text
prettyPrintBinder Binder
b)

prettyPrintLiteralBinder :: Literal Binder -> Text
prettyPrintLiteralBinder :: Literal Binder -> Text
prettyPrintLiteralBinder (StringLiteral PSString
str) = PSString -> Text
prettyPrintString PSString
str
prettyPrintLiteralBinder (CharLiteral Char
c) = [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Char
c)
prettyPrintLiteralBinder (NumericLiteral Either Integer Double
num) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) ([Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) Either Integer Double
num
prettyPrintLiteralBinder (BooleanLiteral Bool
True) = Text
"true"
prettyPrintLiteralBinder (BooleanLiteral Bool
False) = Text
"false"
prettyPrintLiteralBinder (ObjectLiteral [(PSString, Binder)]
bs) =
  Text
"{ "
  forall a. Semigroup a => a -> a -> a
Monoid.<> Text -> [Text] -> Text
T.intercalate Text
", " (forall a b. (a -> b) -> [a] -> [b]
map (PSString, Binder) -> Text
prettyPrintObjectPropertyBinder [(PSString, Binder)]
bs)
  forall a. Semigroup a => a -> a -> a
Monoid.<> Text
" }"
  where
  prettyPrintObjectPropertyBinder :: (PSString, Binder) -> Text
  prettyPrintObjectPropertyBinder :: (PSString, Binder) -> Text
prettyPrintObjectPropertyBinder (PSString
key, Binder
binder) = PSString -> Text
prettyPrintObjectKey PSString
key forall a. Semigroup a => a -> a -> a
Monoid.<> Text
": " forall a. Semigroup a => a -> a -> a
Monoid.<> Binder -> Text
prettyPrintBinder Binder
binder
prettyPrintLiteralBinder (ArrayLiteral [Binder]
bs) =
  Text
"[ "
  forall a. Semigroup a => a -> a -> a
Monoid.<> Text -> [Text] -> Text
T.intercalate Text
", " (forall a b. (a -> b) -> [a] -> [b]
map Binder -> Text
prettyPrintBinder [Binder]
bs)
  forall a. Semigroup a => a -> a -> a
Monoid.<> Text
" ]"

-- |
-- Generate a pretty-printed string representing a Binder
--
prettyPrintBinder :: Binder -> Text
prettyPrintBinder :: Binder -> Text
prettyPrintBinder (ConstructorBinder SourceSpan
_ Qualified (ProperName 'ConstructorName)
ctor []) = forall (a :: ProperNameType). ProperName a -> Text
runProperName (forall a. Qualified a -> a
disqualify Qualified (ProperName 'ConstructorName)
ctor)
prettyPrintBinder (ConstructorBinder SourceSpan
_ Qualified (ProperName 'ConstructorName)
ctor [Binder]
args) = forall (a :: ProperNameType). ProperName a -> Text
runProperName (forall a. Qualified a -> a
disqualify Qualified (ProperName 'ConstructorName)
ctor) forall a. Semigroup a => a -> a -> a
Monoid.<> Text
" " forall a. Semigroup a => a -> a -> a
Monoid.<> [Text] -> Text
T.unwords (forall a b. (a -> b) -> [a] -> [b]
map Binder -> Text
prettyPrintBinderAtom [Binder]
args)
prettyPrintBinder (PositionedBinder SourceSpan
_ [Comment]
_ Binder
binder) = Binder -> Text
prettyPrintBinder Binder
binder
prettyPrintBinder (TypedBinder Type SourceAnn
_ Binder
binder) = Binder -> Text
prettyPrintBinder Binder
binder
prettyPrintBinder Binder
b = Binder -> Text
prettyPrintBinderAtom Binder
b