    {-# 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]
    ""