aboutsummaryrefslogtreecommitdiff
path: root/src/HSVIS/AST.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/HSVIS/AST.hs')
-rw-r--r--src/HSVIS/AST.hs38
1 files changed, 31 insertions, 7 deletions
diff --git a/src/HSVIS/AST.hs b/src/HSVIS/AST.hs
index 8bb2d6c..2b125b9 100644
--- a/src/HSVIS/AST.hs
+++ b/src/HSVIS/AST.hs
@@ -11,6 +11,7 @@ module HSVIS.AST where
import Data.Bifunctor (bimap, first, second)
import qualified Data.Kind as DK
+import Data.List (intersperse)
import Data.List.NonEmpty (NonEmpty)
import Data.Proxy
@@ -136,13 +137,36 @@ data Operator = OAdd | OSub | OMul | ODiv | OMod | OEqu | OPow
deriving (Show)
instance Pretty Name where
- prettysPrec _ (Name n) = showString ("\"" ++ n ++ "\"")
-
-instance (X Kind s ~ (), Pretty (E Kind s)) => Pretty (Kind s) where
- prettysPrec _ (KType ()) = showString "Type"
- prettysPrec d (KFun () a b) =
- showParen (d > -1) $ prettysPrec 0 a . showString " -> " . prettysPrec 0 b
- prettysPrec d (KExt () e) = prettysPrec d e
+ prettysPrec _ (Name n) = showString n
+
+instance Pretty (E Kind s) => Pretty (Kind s) where
+ prettysPrec _ (KType _) = showString "Type"
+ prettysPrec d (KFun _ a b) = showParen (d > -1) $
+ prettysPrec 0 a . showString " -> " . prettysPrec (-1) b
+ prettysPrec d (KExt _ e) = prettysPrec d e
+
+instance Pretty (E Type s) => Pretty (Type s) where
+ prettysPrec d (TApp _ a ts) = showParen (d > 10) $
+ prettysPrec 10 a . foldr (.) id [showString " " . prettysPrec 11 t | t <- ts]
+ prettysPrec _ (TTup _ ts) =
+ showString "(" . foldr (.) id (intersperse (showString ",") (map (prettysPrec 0) ts)) . showString ")"
+ prettysPrec _ (TList _ t) =
+ showString "[" . prettysPrec 0 t . showString "]"
+ prettysPrec d (TFun _ a b) = showParen (d > -1) $
+ prettysPrec 0 a . showString " -> " . prettysPrec (-1) b
+ prettysPrec _ (TCon _ n) = prettysPrec 11 n
+ prettysPrec _ (TVar _ n) = prettysPrec 11 n
+ prettysPrec d (TExt _ e) = prettysPrec d e
+
+instance (Pretty (X Type s), Pretty (E Type s)) => Pretty (DataDef s) where
+ prettysPrec _ (DataDef _ name vars cons) =
+ showString "data " . prettysPrec 11 name
+ . foldr (.) id [showString " (" . prettysPrec 11 n . showString " :: " . prettysPrec 11 k . showString ")"
+ | (k, n) <- vars]
+ . showString " = "
+ . foldr (.) id (intersperse (showString " | ")
+ [prettysPrec 11 cname . foldr (.) id [showString " " . prettysPrec 11 t | t <- fields]
+ | (cname, fields) <- cons])
instance HasExt DataDef where
type HasXField DataDef = 'True