{-# LANGUAGE CPP #-}
#if (__GLASGOW_HASKELL__ < 709)
{-# LANGUAGE OverlappingInstances #-}
{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}
#endif
{- |
   Description: labels are any instance of Typeable

   The HList library

   (C) 2004, Oleg Kiselyov, Ralf Laemmel, Keean Schupke

   Yet another model of labels.

   This model allow us to use any type as label type.
   As a result, we need some generic instances.

   Also, type errors may be more confusing now.
-}

module Data.HList.Label5 where

import Data.Typeable
import Data.Char
import Data.HList.FakePrelude


-- | Equality on labels

-- instance TypeEq x y b => HEq x y b


-- | Show label
instance {-# OVERLAPPABLE #-} Typeable (x :: *) => ShowLabel x
 where
  showLabel :: Label x -> String
showLabel Label x
_ = (\(Char
x:String
xs) -> Char -> Char
toLower Char
xforall a. a -> [a] -> [a]
:String
xs)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> a -> Bool
(==) Char
'.')
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
{-
            . tyConString
            . typeRepTyCon
-}
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => a -> TypeRep
typeOf forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => String -> a
error String
"Data.HList.Label5 has a strict typeOf" :: x)