{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}

{-# OPTIONS_GHC -Wall #-}
-- {-# OPTIONS_GHC -Wno-unused-imports #-} -- TEMP

#define TESTING

#ifdef TESTING
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
#endif

-- | Determine whether the plugin can handle a type. Used in ConCat.Plugin.

module ConCat.OkType (OkType) where

import GHC.TypeLits (KnownNat)
import Data.Finite (Finite)
import Data.Vector.Sized (Vector)

#ifdef TESTING
import ConCat.Misc (Unop)
#endif
import ConCat.Rep

class OkType t

instance OkType ()
instance OkType Bool
instance OkType Int
instance OkType Integer
instance OkType Float
instance OkType Double

instance KnownNat n => OkType (Finite n)
instance (KnownNat n, OkType a) => OkType (Vector n a)

instance (OkType a, OkType b) => OkType (a ,  b)
instance (OkType a, OkType b) => OkType (a -> b)

instance {-# overlappable #-} (HasRep t, OkType (Rep t)) => OkType t

#ifdef TESTING

ok :: OkType t => Unop t
ok :: forall t. OkType t => Unop t
ok = t -> t
forall a. a -> a
id

ok1 :: Unop Int
ok1 = Unop Int
forall t. OkType t => Unop t
ok :: Unop Int
ok2 :: Unop (Bool, Int)
ok2 = Unop (Bool, Int)
forall t. OkType t => Unop t
ok :: Unop (Bool,Int)
ok3 :: Unop (Bool, Int, Bool)
ok3 = Unop (Bool, Int, Bool)
forall t. OkType t => Unop t
ok :: Unop (Bool,Int,Bool)

#endif