{-# LANGUAGE AllowAmbiguousTypes #-}

-- | Template Haskell helpers used to derive type-level bounds.
module CheckedLiterals.Class.TemplateHaskell where

import Data.Typeable (Proxy (Proxy), Typeable, typeRep)
import Language.Haskell.TH (Q, Type, litT, numTyLit)

-- | Reify a type's @maxBound@ as a type-level natural.
maxBoundAsNat :: forall a. (Bounded a, Typeable a, Integral a) => Q Type
maxBoundAsNat :: forall a. (Bounded a, Typeable a, Integral a) => Q Type
maxBoundAsNat
  | Integer
theMaxBound Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = Q TyLit -> Q Type
forall (m :: Type -> Type). Quote m => m TyLit -> m Type
litT (Integer -> Q TyLit
forall (m :: Type -> Type). Quote m => Integer -> m TyLit
numTyLit Integer
theMaxBound)
  | Bool
otherwise =
      String -> Q Type
forall a. HasCallStack => String -> Q a
forall (m :: Type -> Type) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail (String -> Q Type) -> String -> Q Type
forall a b. (a -> b) -> a -> b
$
        String
"The type "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show (Proxy a -> TypeRep
forall {k} (proxy :: k -> Type) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a))
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" has a negative maxBound, so it cannot be used with CheckedLiterals. The maxBound is "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
theMaxBound
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
 where
  theMaxBound :: Integer
theMaxBound = a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
maxBound :: a)

-- | Reify the absolute value of a type's non-positive @minBound@ as a type-level natural.
minBoundAsNat :: forall a. (Bounded a, Integral a, Typeable a) => Q Type
minBoundAsNat :: forall a. (Bounded a, Integral a, Typeable a) => Q Type
minBoundAsNat
  | Integer
theMinBound Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = Q TyLit -> Q Type
forall (m :: Type -> Type). Quote m => m TyLit -> m Type
litT (Integer -> Q TyLit
forall (m :: Type -> Type). Quote m => Integer -> m TyLit
numTyLit (-Integer
theMinBound))
  | Bool
otherwise =
      String -> Q Type
forall a. HasCallStack => String -> Q a
forall (m :: Type -> Type) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail (String -> Q Type) -> String -> Q Type
forall a b. (a -> b) -> a -> b
$
        String
"The type "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show (Proxy a -> TypeRep
forall {k} (proxy :: k -> Type) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a))
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" has a positive, non-zero minBound, so it cannot be used with CheckedLiterals. The minBound is "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
theMinBound
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
 where
  theMinBound :: Integer
theMinBound = a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
minBound :: a)