@@ -21,7 +21,7 @@ module Language.PureScript.Pretty.Values (
2121import Data.Maybe (fromMaybe)
2222import Data.List (intercalate)
2323
24−import Control.Arrow ((<+>), runKleisli)
24+import Control.Arrow ((<+>), runKleisli, second)
2525import Control.PatternArrows
2626import Control.Monad.State
2727import Control.Applicative
@@ -38,33 +38,28 @@ literals = mkPattern' match
3838 match (StringLiteral s) = return $ show s
3939 match (BooleanLiteral True) = return "true"
4040 match (BooleanLiteral False) = return "false"
41− match (ArrayLiteral xs) = fmap concat $ sequence
41+ match (ArrayLiteral xs) = concat <$> sequence
4242 [ return "[ "
4343 , withIndent $ prettyPrintMany prettyPrintValue' xs
4444 , return " ]"
4545 ]
46− match (ObjectLiteral []) = return "{}"
47− match (ObjectLiteral ps) = fmap concat $ sequence
48− [ return "{\n"
49− , withIndent $ prettyPrintMany prettyPrintObjectProperty ps
50− , return "\n"
51− , currentIndent
52− , return "}"
53− ]
54− match (TypeClassDictionaryConstructorApp className ps) = fmap concat $ sequence
55− [ return ((show className) ++ "(\n")
46+ match (ObjectLiteral ps) = prettyPrintObject' $ second Just `map` ps
47+ match (ObjectConstructor ps) = prettyPrintObject' ps
48+ match (ObjectGetter prop) = return $ "(." ++ prop ++ ")"
49+ match (TypeClassDictionaryConstructorApp className ps) = concat <$> sequence
50+ [ return (show className ++ "(\n")
5651 , match ps
5752 , return ")"
5853 ]
5954 match (Constructor name) = return $ show name
60− match (Case values binders) = fmap concat $ sequence
55+ match (Case values binders) = concat <$> sequence
6156 [ return "case "
6257 , unwords <$> forM values prettyPrintValue'
6358 , return " of\n"
6459 , withIndent $ prettyPrintMany prettyPrintCaseAlternative binders
6560 , currentIndent
6661 ]
67− match (Let ds val) = fmap concat $ sequence
62+ match (Let ds val) = concat <$> sequence
6863 [ return "let\n"
6964 , withIndent $ prettyPrintMany prettyPrintDeclaration ds
7065 , return "\n"
@@ -73,7 +68,7 @@ literals = mkPattern' match
7368 , prettyPrintValue' val
7469 ]
7570 match (Var ident) = return $ show ident
76− match (Do els) = fmap concat $ sequence
71+ match (Do els) = concat <$> sequence
7772 [ return "do "
7873 , withIndent $ prettyPrintMany prettyPrintDoNotationElement els
7974 , currentIndent
@@ -86,7 +81,7 @@ literals = mkPattern' match
8681
8782prettyPrintDeclaration :: Declaration -> StateT PrinterState Maybe String
8883prettyPrintDeclaration (TypeDeclaration ident ty) = return $ show ident ++ " :: " ++ prettyPrintType ty
89−prettyPrintDeclaration (ValueDeclaration ident _ [] (Right val)) = fmap concat $ sequence
84+prettyPrintDeclaration (ValueDeclaration ident _ [] (Right val)) = concat <$> sequence
9085 [ return $ show ident ++ " = "
9186 , prettyPrintValue' val
9287 ]
@@ -95,7 +90,7 @@ prettyPrintDeclaration _ = error "Invalid argument to prettyPrintDeclaration"
9590
9691prettyPrintCaseAlternative :: CaseAlternative -> StateT PrinterState Maybe String
9792prettyPrintCaseAlternative (CaseAlternative binders result) =
98− fmap concat $ sequence
93+ concat <$> sequence
9994 [ intercalate ", " <$> forM binders prettyPrintBinder'
10095 , prettyPrintResult result
10196 ]
@@ -104,7 +99,7 @@ prettyPrintCaseAlternative (CaseAlternative binders result) =
10499 prettyPrintResult (Right v) = (" -> " ++) <$> prettyPrintValue' v
105100
106101 prettyPrintGuardedValue (grd, val) =
107− fmap concat $ sequence
102+ concat <$> sequence
108103 [ return "| "
109104 , prettyPrintValue' grd
110105 , return " -> "
@@ -116,18 +111,28 @@ prettyPrintDoNotationElement :: DoNotationElement -> StateT PrinterState Maybe S
116111prettyPrintDoNotationElement (DoNotationValue val) =
117112 prettyPrintValue' val
118113prettyPrintDoNotationElement (DoNotationBind binder val) =
119− fmap concat $ sequence
114+ concat <$> sequence
120115 [ prettyPrintBinder' binder
121116 , return " <- "
122117 , prettyPrintValue' val
123118 ]
124119prettyPrintDoNotationElement (DoNotationLet ds) =
125− fmap concat $ sequence
120+ concat <$> sequence
126121 [ return "let "
127122 , withIndent $ prettyPrintMany prettyPrintDeclaration ds
128123 ]
129124prettyPrintDoNotationElement (PositionedDoNotationElement _ _ el) = prettyPrintDoNotationElement el
130125
126+prettyPrintObject' :: [(String, Maybe Expr)] -> StateT PrinterState Maybe String
127+prettyPrintObject' [] = return "{}"
128+prettyPrintObject' ps = concat <$> sequence
129+ [ return "{\n"
130+ , withIndent $ prettyPrintMany prettyPrintObjectProperty ps
131+ , return "\n"
132+ , currentIndent
133+ , return "}"
134+ ]
135+
131136ifThenElse :: Pattern PrinterState Expr ((Expr, Expr), Expr)
132137ifThenElse = mkPattern match
133138 where
@@ -144,6 +149,7 @@ objectUpdate :: Pattern PrinterState Expr ([String], Expr)
144149objectUpdate = mkPattern match
145150 where
146151 match (ObjectUpdate o ps) = Just (flip map ps $ \(key, val) -> key ++ " = " ++ prettyPrintValue val, o)
152+ match (ObjectUpdater o ps) = Just (flip map ps $ \(key, val) -> key ++ " = " ++ maybe "_" prettyPrintValue val, o)
147153 match _ = Nothing
148154
149155app :: Pattern PrinterState Expr (String, Expr)
@@ -188,17 +194,17 @@ prettyPrintBinderAtom = mkPattern' match
188194 match (BooleanBinder True) = return "true"
189195 match (BooleanBinder False) = return "false"
190196 match (VarBinder ident) = return $ show ident
191− match (ConstructorBinder ctor args) = fmap concat $ sequence
197+ match (ConstructorBinder ctor args) = concat <$> sequence
192198 [ return $ show ctor ++ " "
193199 , unwords <$> forM args match
194200 ]
195− match (ObjectBinder bs) = fmap concat $ sequence
201+ match (ObjectBinder bs) = concat <$> sequence
196202 [ return "{\n"
197203 , withIndent $ prettyPrintMany prettyPrintObjectPropertyBinder bs
198204 , currentIndent
199205 , return "}"
200206 ]
201− match (ArrayBinder bs) = fmap concat $ sequence
207+ match (ArrayBinder bs) = concat <$> sequence
202208 [ return "["
203209 , unwords <$> mapM prettyPrintBinder' bs
204210 , return "]"
@@ -229,13 +235,13 @@ matchConsBinder = mkPattern match'
229235 match' _ = Nothing
230236
231237prettyPrintObjectPropertyBinder :: (String, Binder) -> StateT PrinterState Maybe String
232−prettyPrintObjectPropertyBinder (key, binder) = fmap concat $ sequence
238+prettyPrintObjectPropertyBinder (key, binder) = concat <$> sequence
233239 [ return $ prettyPrintObjectKey key ++ ": "
234240 , prettyPrintBinder' binder
235241 ]
236242
237−prettyPrintObjectProperty :: (String, Expr) -> StateT PrinterState Maybe String
238−prettyPrintObjectProperty (key, value) = fmap concat $ sequence
243+prettyPrintObjectProperty :: (String, Maybe Expr) -> StateT PrinterState Maybe String
244+prettyPrintObjectProperty (key, value) = concat <$> sequence
239245 [ return $ prettyPrintObjectKey key ++ ": "
240− , prettyPrintValue' value
246+ , maybe (pure "_") prettyPrintValue' value
241247 ]