Typecheck work; solver is incorrect

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