-- |
-- Module      :  Test.ChasingBottoms.IsType
-- Copyright   :  (c) Nils Anders Danielsson 2004-2021
-- 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 :: 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 :: 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, but should be OK. 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 :: a -> Bool
isTuple a
x = [Char]
"(," [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` TyCon -> [Char]
forall a. Show a => a -> [Char]
show (a -> TyCon
forall a. Typeable a => a -> TyCon
con a
x)

isString :: Typeable a => a -> Bool
isString :: 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 :: 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]
""