pretty printing improvements

lib/Quox/Definition.idr

@@ -114,4 +114,4 @@ prettyDef name (MkDef qty type _ _) = withPrec Outer $ do
   name  <- prettyFree name
   colon <- colonD
   type  <- prettyTerm [<] [<] type
-  pure $ sep [hsep [hcat [qty, dot, name], colon], type]
+  hangDSingle (hsep [hcat [qty, dot, name], colon]) type

lib/Quox/Pretty.idr

@@ -191,6 +191,14 @@ parameters {opts : LayoutOpts} {auto _ : Foldable t}
   separateTight : Doc opts -> t (Doc opts) -> Doc opts
   separateTight d = sep . exceptLast (<+> d) . toList
 
+  export
+  hseparateTight : Doc opts -> t (Doc opts) -> Doc opts
+  hseparateTight d = hsep . exceptLast (<+> d) . toList
+
+  export
+  vseparateTight : Doc opts -> t (Doc opts) -> Doc opts
+  vseparateTight d = vsep . exceptLast (<+> d) . toList
+
   export
   fillSeparateTight : Doc opts -> t (Doc opts) -> Doc opts
   fillSeparateTight d = fillSep . exceptLast (<+> d) . toList

lib/Quox/Syntax/Term/Pretty.idr

@@ -251,12 +251,11 @@ parameters {opts : LayoutOpts} (dnames : BContext d) (tnames : BContext n)
     body <- withPrec Outer $ assert_total
             prettyTerm (dnames . dbinds) (tnames . tbinds) body
     header <- (pat <++>) <$> darrowD
-    pure $ hsep [header, body] <|> vsep [header, !(indentD body)]
+    pure $ ifMultiline (header <++> body) (vsep [header, !(indentD body)])
 
   private
-  prettyCaseBody : List (CaseArm opts d n) -> Eff Pretty (Doc opts)
-  prettyCaseBody xs =
-    braces . separateTight !semiD =<< traverse prettyCaseArm xs
+  prettyCaseBody : List (CaseArm opts d n) -> Eff Pretty (List (Doc opts))
+  prettyCaseBody xs = traverse prettyCaseArm xs
 
 private
 prettyCompPat : {opts : _} -> DimConst -> BindName -> Eff Pretty (Doc opts)
@@ -299,7 +298,7 @@ prettyCaseRet dnames tnames body = withPrec Outer $ case body of
   S [< x] (Y tm) => do
     header <- [|prettyTBind x <++> darrowD|]
     body   <- assert_total prettyTerm dnames (tnames :< x) tm
-    pure $ hsep [header, body] <|> vsep [header, !(indentD body)]
+    hangDSingle header body
 
 private
 prettyCase_ : {opts : _} ->
@@ -307,10 +306,16 @@ prettyCase_ : {opts : _} ->
               Doc opts -> Elim d n -> ScopeTerm d n -> List (CaseArm opts d n) ->
               Eff Pretty (Doc opts)
 prettyCase_ dnames tnames intro head ret body = do
-  head <- assert_total prettyElim dnames tnames head
-  ret  <- prettyCaseRet dnames tnames ret
-  body <- prettyCaseBody dnames tnames body
-  parensIfM Outer $ sep [intro <++> head, !returnD <++> ret, !ofD <++> body]
+  head   <- assert_total prettyElim dnames tnames head
+  ret    <- prettyCaseRet dnames tnames ret
+  bodys  <- prettyCaseBody dnames tnames body
+  return <- returnD; of_ <- ofD
+  lb     <- hl Delim "{"; rb <- hl Delim "}"; semi <- semiD
+  ind    <- askAt INDENT
+  parensIfM Outer $ ifMultiline
+    (hsep [intro, head, return, ret, of_, lb, hseparateTight semi bodys, rb])
+    (vsep [intro <++> head, return <++> ret, of_ <++> lb,
+           indent ind $ vseparateTight semi bodys, rb])
 
 private
 prettyCase : {opts : _} ->