X-Git-Url: http://git.megacz.com/?p=coq-hetmet.git;a=blobdiff_plain;f=examples%2FGArrowTikZ.hs;h=b3a468f07b3fc86b4f41f8123d4bac141a6cf26e;hp=f545937d112da5f56df2a547b38020d01e5293c5;hb=bb5ad91dc2d9cf1e35895e293b4e3e1478b4af00;hpb=a4a1bd8f36776aa8dd9393cf8d2b6afa0172e978

diff --git a/examples/GArrowTikZ.hs b/examples/GArrowTikZ.hs
index f545937..b3a468f 100644
--- a/examples/GArrowTikZ.hs
+++ b/examples/GArrowTikZ.hs
@@ -1,5 +1,5 @@
-{-# OPTIONS_GHC -XModalTypes -XMultiParamTypeClasses -XNoMonoPatBinds -XKindSignatures -XGADTs -XFlexibleContexts -XFlexibleInstances -XTypeOperators -XUndecidableInstances #-}
-module GArrowTikZ (tikz, GArrowTikZ(..))
+{-# OPTIONS_GHC -XModalTypes -XMultiParamTypeClasses -XNoMonoPatBinds -XKindSignatures -XGADTs -XFlexibleContexts -XFlexibleInstances -XTypeOperators -XUndecidableInstances -XTypeFamilies #-}
+module GArrowTikZ (tikz, tikz', GArrowTikZ(..))
 where
 import Prelude hiding ( id, (.), lookup )
 import Control.Category
@@ -7,7 +7,7 @@ import GHC.HetMet.GArrow
 import Data.List hiding (lookup, insert)
 import Data.Map hiding (map, (!))
 import Unify
-
+import GHC.HetMet.Private
 
 {-
 TO DO:
@@ -128,7 +128,11 @@ instance GArrowLoop GArrowTikZ (**) () where
   ga_loopl     = TikZ_loopl
   ga_loopr     = TikZ_loopr
 
-instance GArrowSTKC GArrowTikZ (,) ()
+type instance GArrowTensor      GArrowTikZ = (,)
+type instance GArrowUnit        GArrowTikZ = ()
+type instance GArrowExponent    GArrowTikZ = (->)
+
+instance GArrowSTKC GArrowTikZ
 
 
 name :: GArrowTikZ a b -> String
@@ -420,6 +424,13 @@ toTikZ' g = foldr (\x y -> x++"\\\\\n"++y) [] (map foo s)
                s = sortit (strip k)
                m = valuatit empty s
 
+tikz' :: (forall g a .
+                 PGArrow g (GArrowUnit g) a ->
+                 (
+                   forall b . PGArrow g (GArrowTensor g b b) b) ->
+                     PGArrow g (GArrowUnit g) a) -> IO ()
+tikz' x = tikz $ unG (x (PGArrowD { unG = TikZ_const 12 }) (PGArrowD { unG = TikZ_merge }) )
+main = do putStrLn "hello"
 tikz example
      = do putStrLn "\\documentclass{article}"
           putStrLn "\\usepackage[landscape,paperheight=20in,textwidth=19in]{geometry}"