diff options
Diffstat (limited to 'src/HSVIS/AST.hs')
-rw-r--r-- | src/HSVIS/AST.hs | 38 |
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 |