msyds/rlp
1
0
Fork 0
Code Issues 4 Pull Requests Actions Packages Projects Releases 2 Wiki Activity

a tad prettier

Browse Source
This commit is contained in:
crumbtoo
2024-03-26 12:56:52 -06:00
parent 55ad136e31
commit 5b6e46e01f
1 changed files with 12 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
src/Rlp/AltSyntax.hs
View File

@@ -169,6 +169,14 @@ instance (Out b) => Out1 (Decl b) where
instance (Out b) => Out (DataCon b) where instance (Out b) => Out (DataCon b) where
out (DataCon n as) = ttext n <+> hsep (outPrec appPrec1 <$> as) out (DataCon n as) = ttext n <+> hsep (outPrec appPrec1 <$> as)
collapseForalls :: Prism' (Type b) ([b], Type b)
collapseForalls = prism' up down where
up (bs,m) = foldr ForallT m bs
down (ForallT x m) = case down m of
Just (xs,m') -> Just (x : xs, m')
Nothing -> Just ([x],m)
down _ = Nothing
-- (->) is given prec `appPrec-1` -- (->) is given prec `appPrec-1`
instance (Out b) => Out (Type b) where instance (Out b) => Out (Type b) where
outPrec _ (VarT n) = ttext n outPrec _ (VarT n) = ttext n
@@ -180,8 +188,10 @@ instance (Out b) => Out (Type b) where
outPrec p (AppT f x) = maybeParens (p>appPrec) $ outPrec p (AppT f x) = maybeParens (p>appPrec) $
outPrec appPrec f <+> outPrec appPrec1 x outPrec appPrec f <+> outPrec appPrec1 x
outPrec p FunT = maybeParens (p>0) "->" outPrec p FunT = maybeParens (p>0) "->"
outPrec p (ForallT x m) = maybeParens (p>0) $ outPrec p t@(ForallT _ _) = maybeParens (p>0) $
hsep [ "∀", ttext x <> ".", outPrec 0 m ] t ^. singular collapseForalls & \(bs,m) ->
let bs' = "∀" <> (hsep $ outPrec appPrec1 <$> bs) <> "."
in bs' <+> outPrec 0 m
instance (Out b) => Out (Pat b) where instance (Out b) => Out (Pat b) where
outPrec p (VarP b) = outPrec p b outPrec p (VarP b) = outPrec p b