{-# LANGUAGE CPP, ScopedTypeVariables #-}

-- |
-- Module      :  Test.ChasingBottoms.IsType
-- Copyright   :  (c) Nils Anders Danielsson 2004-2022, 2024-2025
-- 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)
  String
"Tuple" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
c
    Bool -> Bool -> Bool
&&
  case ReadS Integer
forall a. Read a => ReadS a
reads (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
5 String
c) of
    [(Integer
n :: Integer, String
"")] -> Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
2
    [(Integer, String)]
_                    -> Bool
False
  where
  c :: String
c = TyCon -> String
tyConName (a -> TyCon
forall a. Typeable a => a -> TyCon
con a
x)
#else
  isTuple' (tyConName (con x))
  where
  isTuple' ('(' : ',' : rest) = isTuple'' rest
  isTuple' _                  = False

  isTuple'' ")"          = True
  isTuple'' (',' : rest) = isTuple'' rest
  isTuple'' _            = 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 (String -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf String
"")

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
== String -> TyCon
forall a. Typeable a => a -> TyCon
con String
""