symantic/Language/Symantic/Typing/Show.hs

   1 {-# LANGUAGE PolyKinds #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3 module Language.Symantic.Typing.Show where
   4
   5 import qualified Data.Text.Lazy as TL
   6 import qualified Data.Text.Lazy.Builder as TLB
   7
   8 import qualified Symantic.Document as Doc
   9 import Language.Symantic.Grammar
  10 import Language.Symantic.Typing.Type
  11 import Language.Symantic.Typing.Module
  12 import Language.Symantic.Typing.Document
  13
  14 stringDocTerm :: Doc.PlainText (Doc.Plain TLB.Builder) -> String
  15 stringDocTerm =
  16         TL.unpack .
  17         TLB.toLazyText .
  18         Doc.runPlain .
  19         Doc.runPlainText
  20
  21 showType :: Config_Doc_Type -> Type src vs t -> String
  22 showType conf ty = stringDocTerm $ docType conf 0 ty
  23
  24 showTypeS :: Config_Doc_Type -> Precedence -> Type src vs t -> ShowS
  25 showTypeS conf pr ty = showString $ stringDocTerm $ docType conf pr ty
  26
  27 showTypes :: Config_Doc_Type -> Types src vs ts -> String
  28 showTypes conf tys = stringDocTerm $ docTypes conf tys
  29
  30 showTypesS :: Config_Doc_Type -> Types src vs ts -> ShowS
  31 showTypesS conf tys = showString $ stringDocTerm $ docTypes conf tys
  32
  33 instance NameTyOf c => Show (Const src c) where
  34         showsPrec _p = showString . stringDocTerm . docConst mempty
  35
  36 instance Source src => Show (Type src vs t) where
  37         showsPrec = showTypeS config_Doc_Type
  38 instance Source src => Show (TypeK src vs kt) where
  39         showsPrec p (TypeK t) = showsPrec p t
  40 instance Source src => Show (TypeVT src) where
  41         showsPrec p (TypeVT t) = showsPrec p t
  42 instance Source src => Show (TypeT src vs) where
  43         showsPrec p (TypeT t) = showsPrec p t
  44 instance Source src => Show (Types src vs ts) where
  45         showsPrec _ = showTypesS config_Doc_Type