diff --git a/lib/Quox/Definition.idr b/lib/Quox/Definition.idr index 8bd2fa9..4842c29 100644 --- a/lib/Quox/Definition.idr +++ b/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 diff --git a/lib/Quox/Pretty.idr b/lib/Quox/Pretty.idr index 4753d76..73357ee 100644 --- a/lib/Quox/Pretty.idr +++ b/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 diff --git a/lib/Quox/Syntax/Term/Pretty.idr b/lib/Quox/Syntax/Term/Pretty.idr index 691cfd6..a14974c 100644 --- a/lib/Quox/Syntax/Term/Pretty.idr +++ b/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 : _} ->