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 FixityOf Show
  49 instance ClassInstancesFor Show
  50 instance TypeInstancesFor Show
  51
  52 -- Compiling
  53 instance Gram_Term_AtomsFor src ss g Show
  54 instance (Source src, SymInj ss Show) => ModuleFor src ss Show where
  55         moduleFor = ["Show"] `moduleWhere`
  56          [ "showsPrec" := teShow_showsPrec
  57          , "show"      := teShow_show
  58          , "showList"  := teShow_showList
  59          ]
  60
  61 -- ** 'Type's
  62 tyShow :: Source src => Type src vs a -> Type src vs (Show a)
  63 tyShow a = tyConstLen @(K Show) @Show (lenVars a) `tyApp` a
  64
  65 tyShowS :: Source src => LenInj vs => Type src vs ShowS
  66 tyShowS = tyString ~> tyString
  67
  68 -- ** 'Term's
  69 teShow_showsPrec :: TermDef Show '[Proxy a] (Show a #> (Int -> a -> ShowS))
  70 teShow_showsPrec = Term (tyShow a0) (tyInt ~> a0 ~> tyShowS) $ teSym @Show $ lam2 showsPrec
  71
  72 teShow_show :: TermDef Show '[Proxy a] (Show a #> (a -> String))
  73 teShow_show = Term (tyShow a0) (a0 ~> tyString) $ teSym @Show $ lam1 show
  74
  75 teShow_showList :: TermDef Show '[Proxy a] (Show a #> ([a] -> ShowS))
  76 teShow_showList = Term (tyShow a0) (tyList a0 ~> tyShowS) $ teSym @Show $ lam1 showList