{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

{-# OPTIONS_GHC -fplugin=IfCt.Plugin #-}

module M1 where

-- base

import Data.Kind
  ( Type )

-- if-instance

import Data.Constraint.If
  ( IfCt(ifCt) )

--------------------------------------------------------------------------------


showFun :: forall (a :: Type). IfCt ( Show ( a -> a ) ) => ( a -> a ) -> String
showFun :: forall a. IfCt (Show (a -> a)) => (a -> a) -> String
showFun = forall (ct :: Constraint) r. IfCt ct => (ct => r) -> r -> r
ifCt @( Show (a -> a) ) Show (a -> a) => (a -> a) -> String
forall a. Show a => a -> String
show ( \ a -> a
_ -> String
"<<function>>" )

test1 :: ( Bool -> Bool ) -> String
test1 :: (Bool -> Bool) -> String
test1 Bool -> Bool
fun = (Bool -> Bool) -> String
forall a. IfCt (Show (a -> a)) => (a -> a) -> String
showFun Bool -> Bool
fun