{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Generic.Proxy
  ( conNameP,
    isRecordP,
    selNameP,
    symbolName,
    CProxy (..),
    CBox (..),
    rep,
    foldProxy,
    runCBox,
  )
where

import Data.List (init, last)
import GHC.Generics
  ( C,
    Constructor,
    Generic (..),
    M1 (..),
    Meta,
    S,
    Selector (..),
    U1 (..),
    conIsRecord,
    conName,
  )
import GHC.TypeLits
import Relude hiding (init, last, undefined)
import Prelude (undefined)

conNameP :: forall f t (c :: Meta). (Constructor c, IsString t) => f c -> t
conNameP :: forall (f :: Meta -> *) t (c :: Meta).
(Constructor c, IsString t) =>
f c -> t
conNameP f c
_ = String -> t
forall a. IsString a => String -> a
fromString (String -> t) -> String -> t
forall a b. (a -> b) -> a -> b
$ M1 C c U1 Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName (M1 C c U1 a
forall {k} {a :: k}. M1 C c U1 a
forall a. HasCallStack => a
undefined :: M1 C c U1 a)

dropLiterals :: String -> String
dropLiterals :: String -> String
dropLiterals String
name
  | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
name) Bool -> Bool -> Bool
&& (String -> Char
forall a. HasCallStack => [a] -> a
last String
name Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'') = String -> String
forall a. HasCallStack => [a] -> [a]
init String
name
  | Bool
otherwise = String
name
{-# INLINE dropLiterals #-}

isRecordP :: forall f (c :: Meta). (Constructor c) => f c -> Bool
isRecordP :: forall (f :: Meta -> *) (c :: Meta). Constructor c => f c -> Bool
isRecordP f c
_ = M1 C c f Any -> Bool
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> Bool
conIsRecord (M1 C c f a
forall a. HasCallStack => a
forall {a :: Meta}. M1 C c f a
undefined :: (M1 C c f a))

selNameP :: forall f t (s :: Meta). (Selector s, IsString t) => f s -> t
selNameP :: forall (f :: Meta -> *) t (s :: Meta).
(Selector s, IsString t) =>
f s -> t
selNameP f s
_ = String -> t
forall a. IsString a => String -> a
fromString (String -> t) -> String -> t
forall a b. (a -> b) -> a -> b
$ String -> String
dropLiterals (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ M1 S s f Any -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName (M1 S s f a
forall a. HasCallStack => a
forall {a :: Meta}. M1 S s f a
undefined :: M1 S s f a)

symbolName :: (KnownSymbol a, IsString t) => f a -> t
symbolName :: forall (a :: Symbol) t (f :: Symbol -> *).
(KnownSymbol a, IsString t) =>
f a -> t
symbolName = String -> t
forall a. IsString a => String -> a
fromString (String -> t) -> (f a -> String) -> f a -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal

-- | constrained proxy
data CProxy constraint where
  CProxy :: forall f constraint a. (constraint a) => f a -> CProxy constraint

foldProxy :: (forall f a. (c a) => f a -> b) -> CProxy c -> b
foldProxy :: forall {k} (c :: k -> Constraint) b.
(forall (f :: k -> *) (a :: k). c a => f a -> b) -> CProxy c -> b
foldProxy forall (f :: k -> *) (a :: k). c a => f a -> b
f (CProxy f a
x) = f a -> b
forall (f :: k -> *) (a :: k). c a => f a -> b
f f a
x

data CBox box constraint where
  CBox :: forall constraint box a. (constraint a) => box a -> CBox box constraint

runCBox :: (forall a. (c a) => f a -> b) -> CBox f c -> b
runCBox :: forall {k} (c :: k -> Constraint) (f :: k -> *) b.
(forall (a :: k). c a => f a -> b) -> CBox f c -> b
runCBox forall (a :: k). c a => f a -> b
f (CBox f a
x) = f a -> b
forall (a :: k). c a => f a -> b
f f a
x

rep :: f a -> Proxy (Rep a)
rep :: forall (f :: * -> *) a. f a -> Proxy (Rep a)
rep f a
_ = Proxy (Rep a)
forall {k} (t :: k). Proxy t
Proxy