symantic-lib/Language/Symantic/Lib/Show.hs

   1 {-# LANGUAGE UndecidableInstances #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3 -- | Symantic for 'Show'.
   4 module Language.Symantic.Lib.Show where
   5
   6 import Prelude hiding (Show(..))
   7 import Text.Show (Show)
   8 import qualified Text.Show as Show
   9
  10 import Language.Symantic
  11 import Language.Symantic.Lib.Char (tyString)
  12 import Language.Symantic.Lib.Function (a0)
  13 import Language.Symantic.Lib.Int (tyInt)
  14 import Language.Symantic.Lib.List (tyList)
  15
  16 -- * Class 'Sym_Show'
  17 type instance Sym Show = Sym_Show
  18 class Sym_Show term where
  19         showsPrec :: Show a => term Int -> term a -> term ShowS
  20         show      :: Show a => term a -> term String
  21         showList  :: Show a => term [a] -> term ShowS
  22
  23         default showsPrec :: Sym_Show (UnT term) => Trans term => Show a => term Int -> term a -> term ShowS
  24         default show      :: Sym_Show (UnT term) => Trans term => Show a => term a -> term String
  25         default showList  :: Sym_Show (UnT term) => Trans term => Show a => term [a] -> term ShowS
  26
  27         showsPrec = trans2 showsPrec
  28         show      = trans1 show
  29         showList  = trans1 showList
  30
  31 instance Sym_Show Eval where
  32         showsPrec = eval2 Show.showsPrec
  33         show      = eval1 Show.show
  34         showList  = eval1 Show.showList
  35 instance Sym_Show View where
  36         showsPrec = view2 "showsPrec"
  37         show      = view1 "show"
  38         showList  = view1 "showList"
  39 instance (Sym_Show r1, Sym_Show r2) => Sym_Show (Dup r1 r2) where
  40         showsPrec = dup2 @Sym_Show showsPrec
  41         show      = dup1 @Sym_Show show
  42         showList  = dup1 @Sym_Show showList
  43
  44 -- Transforming
  45 instance (Sym_Show term, Sym_Lambda term) => Sym_Show (BetaT term)
  46
  47 -- Typing
  48 instance NameTyOf Show where
  49         nameTyOf _c = ["Show"] `Mod` "Show"
  50 instance FixityOf Show
  51 instance ClassInstancesFor Show
  52 instance TypeInstancesFor Show
  53
  54 -- Compiling
  55 instance Gram_Term_AtomsFor src ss g Show
  56 instance (Source src, SymInj ss Show) => ModuleFor src ss Show where
  57         moduleFor = ["Show"] `moduleWhere`
  58          [ "showsPrec" := teShow_showsPrec
  59          , "show"      := teShow_show
  60          , "showList"  := teShow_showList
  61          ]
  62
  63 -- ** 'Type's
  64 tyShow :: Source src => Type src vs a -> Type src vs (Show a)
  65 tyShow a = tyConstLen @(K Show) @Show (lenVars a) `tyApp` a
  66
  67 tyShowS :: Source src => LenInj vs => Type src vs ShowS
  68 tyShowS = tyString ~> tyString
  69
  70 -- ** 'Term's
  71 teShow_showsPrec :: TermDef Show '[Proxy a] (Show a #> (Int -> a -> ShowS))
  72 teShow_showsPrec = Term (tyShow a0) (tyInt ~> a0 ~> tyShowS) $ teSym @Show $ lam2 showsPrec
  73
  74 teShow_show :: TermDef Show '[Proxy a] (Show a #> (a -> String))
  75 teShow_show = Term (tyShow a0) (a0 ~> tyString) $ teSym @Show $ lam1 show
  76
  77 teShow_showList :: TermDef Show '[Proxy a] (Show a #> ([a] -> ShowS))
  78 teShow_showList = Term (tyShow a0) (tyList a0 ~> tyShowS) $ teSym @Show $ lam1 showList