{-# LANGUAGE CPP, ScopedTypeVariables #-}

-- |
-- Module      :  Test.ChasingBottoms.IsType
-- Copyright   :  (c) Nils Anders Danielsson 2004-2022, 2024
-- License     :  See the file LICENCE.
--
-- Maintainer  :  http://www.cse.chalmers.se/~nad/
-- Stability   :  experimental
-- Portability :  non-portable (GHC-specific)
--
-- Internal helper functions.

module Test.ChasingBottoms.IsType
  ( isFunction
  , isTuple
  , isList
  , isString
  ) where

import Data.List
import Data.Typeable

-- | '@isFunction@ f' returns 'True' iff the top level \"constructor\"
-- of @f@ is a function arrow.
isFunction :: Typeable a => a -> Bool
isFunction :: forall a. Typeable a => a -> Bool
isFunction a
f = a -> TyCon
forall a. Typeable a => a -> TyCon
con a
f TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== (Bool -> Bool) -> TyCon
forall a. Typeable a => a -> TyCon
con Bool -> Bool
not  -- TyCon is abstract.

con :: Typeable a => a -> TyCon
con :: forall a. Typeable a => a -> TyCon
con = TypeRep -> TyCon
typeRepTyCon (TypeRep -> TyCon) -> (a -> TypeRep) -> a -> TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf

-- | This function is rather fragile. However, it is only used by
-- "Test.ChasingBottoms.ApproxShow", which should only be used for
-- debugging purposes anyway. The unit type is not considered to be a
-- tuple.
isTuple :: Typeable a => a -> Bool
isTuple :: forall a. Typeable a => a -> Bool
isTuple a
x =
#if MIN_VERSION_base(4,19,0)
  "Tuple" `isPrefixOf` c
    &&
  case reads (drop 5 c) of
    [(n :: Integer, "")] -> n >= 2
    _                    -> False
  where
  c = tyConName (con x)
#else
  [Char] -> Bool
isTuple' (TyCon -> [Char]
tyConName (a -> TyCon
forall a. Typeable a => a -> TyCon
con a
x))
  where
  isTuple' :: [Char] -> Bool
isTuple' (Char
'(' : Char
',' : [Char]
rest) = [Char] -> Bool
isTuple'' [Char]
rest
  isTuple' [Char]
_                  = Bool
False

  isTuple'' :: [Char] -> Bool
isTuple'' [Char]
")"          = Bool
True
  isTuple'' (Char
',' : [Char]
rest) = [Char] -> Bool
isTuple'' [Char]
rest
  isTuple'' [Char]
_            = Bool
False
#endif

isString :: Typeable a => a -> Bool
isString :: forall a. Typeable a => a -> Bool
isString a
x = a -> Bool
forall a. Typeable a => a -> Bool
isList a
x Bool -> Bool -> Bool
&& TypeRep -> [TypeRep]
typeRepArgs (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
x) [TypeRep] -> [TypeRep] -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep -> [TypeRep]
typeRepArgs ([Char] -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf [Char]
"")

isList :: Typeable a => a -> Bool
isList :: forall a. Typeable a => a -> Bool
isList a
x = a -> TyCon
forall a. Typeable a => a -> TyCon
con a
x TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> TyCon
forall a. Typeable a => a -> TyCon
con [Char]
""