{-# LANGUAGE
    BangPatterns,
    EmptyCase,
    FlexibleContexts,
    PolyKinds,
    Trustworthy #-}

-- | Utilities.
--
-- === Warning
--
-- This is an internal module: it is not subject to any versioning policy,
-- breaking changes can happen at any time.
--
-- If something here seems useful, please report it or create a pull request to
-- export it from an external module.

module Generic.Data.Internal.Utils where

import Data.Coerce
import GHC.Generics
import GHC.Lexeme (startsConSym, startsVarSym)

-- | Convert between types with representationally equivalent generic
-- representations.
gcoerce
  :: (Generic a, Generic b, Coercible (Rep a) (Rep b))
  => a -> b
gcoerce :: a -> b
gcoerce = Rep b Any -> b
forall a x. Generic a => Rep a x -> a
to (Rep b Any -> b) -> (a -> Rep b Any) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep a Any -> Rep b Any
forall k (f :: k -> *) (g :: k -> *) (x :: k).
Coercible f g =>
f x -> g x
coerce1 (Rep a Any -> Rep b Any) -> (a -> Rep a Any) -> a -> Rep b Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

-- | Compose 'gcoerce' with a binary operation.
gcoerceBinop
  :: (Generic a, Generic b, Coercible (Rep a) (Rep b))
  => (a -> a -> a) -> (b -> b -> b)
gcoerceBinop :: (a -> a -> a) -> b -> b -> b
gcoerceBinop a -> a -> a
f b
x b
y = a -> b
forall a b.
(Generic a, Generic b, Coercible (Rep a) (Rep b)) =>
a -> b
gcoerce (a -> a -> a
f (b -> a
forall a b.
(Generic a, Generic b, Coercible (Rep a) (Rep b)) =>
a -> b
gcoerce b
x) (b -> a
forall a b.
(Generic a, Generic b, Coercible (Rep a) (Rep b)) =>
a -> b
gcoerce b
y))

-- | Coerce while preserving the type index.
coerce' :: Coercible (f x) (g x) => f x -> g x
coerce' :: f x -> g x
coerce' = f x -> g x
coerce

coerce1 :: Coercible f g => f x -> g x
coerce1 :: f x -> g x
coerce1 = f x -> g x
coerce

-- | Elimination of @V1@.
absurd1 :: V1 x -> a
absurd1 :: V1 x -> a
absurd1 V1 x
x = case V1 x
x of {}

-- | A helper for better type inference.
from' :: Generic a => a -> Rep a ()
from' :: a -> Rep a ()
from' = a -> Rep a ()
forall a x. Generic a => a -> Rep a x
from

-- | A helper for better type inference.
to' :: Generic a => Rep a () -> a
to' :: Rep a () -> a
to' = Rep a () -> a
forall a x. Generic a => Rep a x -> a
to

-- | Lift binary combinators generically.
liftG2 :: Generic1 f => (Rep1 f a -> Rep1 f b -> Rep1 f c) -> f a -> f b -> f c
liftG2 :: (Rep1 f a -> Rep1 f b -> Rep1 f c) -> f a -> f b -> f c
liftG2 = \Rep1 f a -> Rep1 f b -> Rep1 f c
(<?>) f a
a f b
b -> Rep1 f c -> f c
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 (f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f a
a Rep1 f a -> Rep1 f b -> Rep1 f c
<?> f b -> Rep1 f b
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f b
b)

-- | Returns 'True' if the argument is a symbolic data constructor name
-- (e.g., @(:+:)@). Returns 'False' otherwise.
isSymDataCon :: String -> Bool
isSymDataCon :: String -> Bool
isSymDataCon String
""    = Bool
False
isSymDataCon (Char
c:String
_) = Char -> Bool
startsConSym Char
c

-- | Returns 'True' if the argument is a symbolic value name (e.g., @(+++)@).
-- Returns 'False' otherwise.
isSymVar :: String -> Bool
isSymVar :: String -> Bool
isSymVar String
""    = Bool
False
isSymVar (Char
c:String
_) = Char -> Bool
startsVarSym Char
c