Add colorable and decorable.
[haskell/symantic.git] / symantic / Language / Symantic / Typing / Show.hs
index 0c6305905f287e01e3bb60be716fb5b81e3db64d..cbd360d534d1180ff549ae2b75f2975f038d07c2 100644 (file)
@@ -2,29 +2,32 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Language.Symantic.Typing.Show where
 
-import Data.Semigroup ((<>))
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Builder as TLB
 
 import qualified Language.Symantic.Document as D
 import Language.Symantic.Grammar
 import Language.Symantic.Typing.Type
+import Language.Symantic.Typing.Module
 import Language.Symantic.Typing.Document
 
 showType :: Config_Doc_Type -> Type src vs t -> String
 showType conf ty = TL.unpack $ TLB.toLazyText $ D.plain $ docType conf 0 ty
 
 showTypeS :: Config_Doc_Type -> Precedence -> Type src vs t -> ShowS
-showTypeS conf pr ty s = s <> TL.unpack (TLB.toLazyText $ D.plain $ docType conf pr ty)
+showTypeS conf pr ty = showString $ TL.unpack (TLB.toLazyText $ D.plain $ docType conf pr ty)
 
 showTypes :: Config_Doc_Type -> Types src vs ts -> String
 showTypes conf tys = TL.unpack (TLB.toLazyText $ D.plain $ docTypes conf tys)
 
 showTypesS :: Config_Doc_Type -> Types src vs ts -> ShowS
-showTypesS conf tys s = s <> TL.unpack (TLB.toLazyText $ D.plain $ docTypes conf tys)
+showTypesS conf tys = showString $ TL.unpack (TLB.toLazyText $ D.plain $ docTypes conf tys)
+
+instance NameTyOf c => Show (Const src c) where
+       showsPrec _p = showString . TL.unpack . TLB.toLazyText . D.plain . docConst mempty
 
 instance Source src => Show (Type src vs t) where
-       showsPrec = showTypeS config_doc_type
+       showsPrec = showTypeS config_Doc_Type
 instance Source src => Show (TypeK src vs kt) where
        showsPrec p (TypeK t) = showsPrec p t
 instance Source src => Show (TypeVT src) where
@@ -32,4 +35,4 @@ instance Source src => Show (TypeVT src) where
 instance Source src => Show (TypeT src vs) where
        showsPrec p (TypeT t) = showsPrec p t
 instance Source src => Show (Types src vs ts) where
-       showsPrec _ = showTypesS config_doc_type
+       showsPrec _ = showTypesS config_Doc_Type