module Type.Base.Proxy where

import Control.Applicative (Applicative, pure, (<*>), )

import qualified Prelude as P
import Prelude (String, Eq, Functor, fmap)


data Proxy a = Proxy
   deriving (Proxy a -> Proxy a -> Bool
(Proxy a -> Proxy a -> Bool)
-> (Proxy a -> Proxy a -> Bool) -> Eq (Proxy a)
forall a. Proxy a -> Proxy a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Proxy a -> Proxy a -> Bool
$c/= :: forall a. Proxy a -> Proxy a -> Bool
== :: Proxy a -> Proxy a -> Bool
$c== :: forall a. Proxy a -> Proxy a -> Bool
Eq)

instance Functor Proxy where
   fmap :: (a -> b) -> Proxy a -> Proxy b
fmap a -> b
_f Proxy a
Proxy = Proxy b
forall a. Proxy a
Proxy

instance Applicative Proxy where
   pure :: a -> Proxy a
pure a
_ = Proxy a
forall a. Proxy a
Proxy
   Proxy (a -> b)
Proxy <*> :: Proxy (a -> b) -> Proxy a -> Proxy b
<*> Proxy a
Proxy = Proxy b
forall a. Proxy a
Proxy


class Show a where
   showsPrec :: P.Int -> Proxy a -> P.ShowS

instance Show a => P.Show (Proxy a) where
   showsPrec :: Int -> Proxy a -> ShowS
showsPrec = Int -> Proxy a -> ShowS
forall a. Show a => Int -> Proxy a -> ShowS
showsPrec