-- |
-- 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 qualified Data.List.NonEmpty as NEL
import qualified Data.Monoid as Monoid ((<>))
import qualified Data.Text as T

import Language.PureScript.AST
import Language.PureScript.Crash
import Language.PureScript.Names
import Language.PureScript.Pretty.Common
import Language.PureScript.Pretty.Types (typeAsBox, typeAtomAsBox, prettyPrintObjectKey)
import Language.PureScript.Types (Constraint(..))
import Language.PureScript.PSString (PSString, prettyPrintString)

import Text.PrettyPrint.Boxes

-- 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