{-# 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 :: forall a b.
(Generic a, Generic b, Coercible (Rep a) (Rep b)) =>
a -> b
gcoerce = forall a x. Generic a => Rep a x -> a
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (g :: k -> *) (x :: k).
Coercible f g =>
f x -> g x
coerce1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b.
(Generic a, Generic b, Coercible (Rep a) (Rep b)) =>
(a -> a -> a) -> b -> b -> b
gcoerceBinop a -> a -> a
f b
x b
y = forall a b.
(Generic a, Generic b, Coercible (Rep a) (Rep b)) =>
a -> b
gcoerce (a -> a -> a
f (forall a b.
(Generic a, Generic b, Coercible (Rep a) (Rep b)) =>
a -> b
gcoerce b
x) (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' :: forall {k} (f :: k -> *) (x :: k) (g :: k -> *).
Coercible (f x) (g x) =>
f x -> g x
coerce' = coerce :: forall a b. Coercible a b => a -> b
coerce

coerce1 :: Coercible f g => f x -> g x
coerce1 :: forall {k} (f :: k -> *) (g :: k -> *) (x :: k).
Coercible f g =>
f x -> g x
coerce1 = coerce :: forall a b. Coercible a b => a -> b
coerce

-- | Elimination of @V1@.
absurd1 :: V1 x -> a
absurd1 :: forall {k} (x :: k) a. 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' :: forall a. Generic a => a -> Rep a ()
from' = forall a x. Generic a => a -> Rep a x
from

-- | A helper for better type inference.
to' :: Generic a => Rep a () -> a
to' :: forall a. Generic a => Rep a () -> a
to' = 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 :: forall {k} (f :: k -> *) (a :: k) (b :: k) (c :: k).
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
a f b
b -> forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 (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
<?> 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