{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Util.SOP (
    constrName
  , constrNames
  ) where

import           Data.Proxy
import qualified Generics.SOP as SOP

constrInfo :: SOP.HasDatatypeInfo a
           => proxy a
           -> SOP.NP SOP.ConstructorInfo (SOP.Code a)
constrInfo :: forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> NP ConstructorInfo (Code a)
constrInfo = DatatypeInfo (Code a) -> NP ConstructorInfo (Code a)
forall (xss :: [[*]]). DatatypeInfo xss -> NP ConstructorInfo xss
SOP.constructorInfo (DatatypeInfo (Code a) -> NP ConstructorInfo (Code a))
-> (proxy a -> DatatypeInfo (Code a))
-> proxy a
-> NP ConstructorInfo (Code a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy a -> DatatypeInfo (Code a)
forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
forall (proxy :: * -> *). proxy a -> DatatypeInfo (Code a)
SOP.datatypeInfo

constrName :: forall a. SOP.HasDatatypeInfo a => a -> String
constrName :: forall a. HasDatatypeInfo a => a -> String
constrName a
a =
    NS (K String) (Code a) -> CollapseTo NS String
forall (xs :: [[*]]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
SOP.hcollapse (NS (K String) (Code a) -> CollapseTo NS String)
-> NS (K String) (Code a) -> CollapseTo NS String
forall a b. (a -> b) -> a -> b
$ (forall (a :: [*]). ConstructorInfo a -> NP I a -> K String a)
-> Prod NS ConstructorInfo (Code a)
-> NS (NP I) (Code a)
-> NS (K String) (Code a)
forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(SListIN (Prod h) xs, HAp h, HAp (Prod h)) =>
(forall (a :: k). f a -> f' a -> f'' a)
-> Prod h f xs -> h f' xs -> h f'' xs
SOP.hliftA2 ConstructorInfo a -> NP I a -> K String a
forall (a :: [*]). ConstructorInfo a -> NP I a -> K String a
go (Proxy a -> NP ConstructorInfo (Code a)
forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> NP ConstructorInfo (Code a)
constrInfo Proxy a
p) (SOP I (Code a) -> NS (NP I) (Code a)
forall {k} (f :: k -> *) (xss :: [[k]]). SOP f xss -> NS (NP f) xss
SOP.unSOP (a -> SOP I (Code a)
forall a. Generic a => a -> Rep a
SOP.from a
a))
  where
    go :: SOP.ConstructorInfo b -> SOP.NP SOP.I b -> SOP.K String b
    go :: forall (a :: [*]). ConstructorInfo a -> NP I a -> K String a
go ConstructorInfo b
nfo NP I b
_ = String -> K String b
forall k a (b :: k). a -> K a b
SOP.K (String -> K String b) -> String -> K String b
forall a b. (a -> b) -> a -> b
$ ConstructorInfo b -> String
forall (xs :: [*]). ConstructorInfo xs -> String
SOP.constructorName ConstructorInfo b
nfo

    p :: Proxy a
p = forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a

constrNames :: SOP.HasDatatypeInfo a => proxy a -> [String]
constrNames :: forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> [String]
constrNames proxy a
p =
    NP (K String) (Code a) -> CollapseTo NP String
forall (xs :: [[*]]) a.
SListIN NP xs =>
NP (K a) xs -> CollapseTo NP a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
SOP.hcollapse (NP (K String) (Code a) -> CollapseTo NP String)
-> NP (K String) (Code a) -> CollapseTo NP String
forall a b. (a -> b) -> a -> b
$ (forall (a :: [*]). ConstructorInfo a -> K String a)
-> NP ConstructorInfo (Code a) -> NP (K String) (Code a)
forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *).
(SListIN (Prod h) xs, HAp h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
SOP.hmap ConstructorInfo a -> K String a
forall (a :: [*]). ConstructorInfo a -> K String a
go (proxy a -> NP ConstructorInfo (Code a)
forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> NP ConstructorInfo (Code a)
constrInfo proxy a
p)
  where
    go :: SOP.ConstructorInfo a -> SOP.K String a
    go :: forall (a :: [*]). ConstructorInfo a -> K String a
go ConstructorInfo a
nfo = String -> K String a
forall k a (b :: k). a -> K a b
SOP.K (String -> K String a) -> String -> K String a
forall a b. (a -> b) -> a -> b
$ ConstructorInfo a -> String
forall (xs :: [*]). ConstructorInfo xs -> String
SOP.constructorName ConstructorInfo a
nfo