{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Plow.Logging.EnumerableConstructors (HasEnumerableConstructors (..)) where

import Data.Proxy
import GHC.Generics

class HasEnumerableConstructors1 f where
  listConstructors1 :: f p -> [String]
  allConstructors1 :: Proxy f -> [String]

instance HasEnumerableConstructors1 V1 where
  listConstructors1 :: forall p. V1 p -> [String]
listConstructors1 V1 p
_ = []
  allConstructors1 :: Proxy V1 -> [String]
allConstructors1 Proxy V1
_ = []

instance HasEnumerableConstructors1 U1 where
  listConstructors1 :: forall p. U1 p -> [String]
listConstructors1 U1 p
_ = []
  allConstructors1 :: Proxy U1 -> [String]
allConstructors1 Proxy U1
_ = []

instance (HasEnumerableConstructors a) => HasEnumerableConstructors1 (K1 i a) where
  listConstructors1 :: forall p. K1 i a p -> [String]
listConstructors1 (K1 a
x) = forall a. HasEnumerableConstructors a => a -> [String]
listConstructors a
x
  allConstructors1 :: Proxy (K1 i a) -> [String]
allConstructors1 Proxy (K1 i a)
_ = forall a. HasEnumerableConstructors a => Proxy a -> [String]
allConstructors (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance HasEnumerableConstructors1 f => HasEnumerableConstructors1 (D1 c f) where
  listConstructors1 :: forall p. D1 c f p -> [String]
listConstructors1 (M1 f p
x) = forall (f :: * -> *) p.
HasEnumerableConstructors1 f =>
f p -> [String]
listConstructors1 f p
x
  allConstructors1 :: Proxy (D1 c f) -> [String]
allConstructors1 Proxy (D1 c f)
_ = forall (f :: * -> *).
HasEnumerableConstructors1 f =>
Proxy f -> [String]
allConstructors1 (forall {k} (t :: k). Proxy t
Proxy :: Proxy f)

instance (Constructor c, HasEnumerableConstructors1 f) => HasEnumerableConstructors1 (C1 c f) where
  listConstructors1 :: forall p. C1 c f p -> [String]
listConstructors1 x :: C1 c f p
x@(M1 f p
y) = [forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName C1 c f p
x] forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) p.
HasEnumerableConstructors1 f =>
f p -> [String]
listConstructors1 f p
y
  allConstructors1 :: Proxy (C1 c f) -> [String]
allConstructors1 Proxy (C1 c f)
_ = [forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (forall a. HasCallStack => a
undefined :: C1 c f g)] forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *).
HasEnumerableConstructors1 f =>
Proxy f -> [String]
allConstructors1 (forall {k} (t :: k). Proxy t
Proxy :: Proxy f)

instance HasEnumerableConstructors1 f => HasEnumerableConstructors1 (S1 c f) where
  listConstructors1 :: forall p. S1 c f p -> [String]
listConstructors1 (M1 f p
x) = forall (f :: * -> *) p.
HasEnumerableConstructors1 f =>
f p -> [String]
listConstructors1 f p
x
  allConstructors1 :: Proxy (S1 c f) -> [String]
allConstructors1 Proxy (S1 c f)
_ = forall (f :: * -> *).
HasEnumerableConstructors1 f =>
Proxy f -> [String]
allConstructors1 (forall {k} (t :: k). Proxy t
Proxy :: Proxy f)

instance (HasEnumerableConstructors1 a, HasEnumerableConstructors1 b) => HasEnumerableConstructors1 (a :+: b) where
  listConstructors1 :: forall p. (:+:) a b p -> [String]
listConstructors1 (L1 a p
x) = forall (f :: * -> *) p.
HasEnumerableConstructors1 f =>
f p -> [String]
listConstructors1 a p
x
  listConstructors1 (R1 b p
x) = forall (f :: * -> *) p.
HasEnumerableConstructors1 f =>
f p -> [String]
listConstructors1 b p
x

  allConstructors1 :: Proxy (a :+: b) -> [String]
allConstructors1 Proxy (a :+: b)
_ = (forall (f :: * -> *).
HasEnumerableConstructors1 f =>
Proxy f -> [String]
allConstructors1 (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) forall a. [a] -> [a] -> [a]
++ (forall (f :: * -> *).
HasEnumerableConstructors1 f =>
Proxy f -> [String]
allConstructors1 (forall {k} (t :: k). Proxy t
Proxy :: Proxy b)))

instance (HasEnumerableConstructors1 a, HasEnumerableConstructors1 b) => HasEnumerableConstructors1 (a :*: b) where
  listConstructors1 :: forall p. (:*:) a b p -> [String]
listConstructors1 (a p
a :*: b p
b) = forall (f :: * -> *) p.
HasEnumerableConstructors1 f =>
f p -> [String]
listConstructors1 a p
a forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) p.
HasEnumerableConstructors1 f =>
f p -> [String]
listConstructors1 b p
b
  allConstructors1 :: Proxy (a :*: b) -> [String]
allConstructors1 Proxy (a :*: b)
_ = (forall (f :: * -> *).
HasEnumerableConstructors1 f =>
Proxy f -> [String]
allConstructors1 (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) forall a. [a] -> [a] -> [a]
++ (forall (f :: * -> *).
HasEnumerableConstructors1 f =>
Proxy f -> [String]
allConstructors1 (forall {k} (t :: k). Proxy t
Proxy :: Proxy b)))

instance HasEnumerableConstructors1 f => HasEnumerableConstructors1 (Rec1 f) where
  listConstructors1 :: forall p. Rec1 f p -> [String]
listConstructors1 (Rec1 f p
a) = forall (f :: * -> *) p.
HasEnumerableConstructors1 f =>
f p -> [String]
listConstructors1 f p
a
  allConstructors1 :: Proxy (Rec1 f) -> [String]
allConstructors1 Proxy (Rec1 f)
_ = forall (f :: * -> *).
HasEnumerableConstructors1 f =>
Proxy f -> [String]
allConstructors1 (forall {k} (t :: k). Proxy t
Proxy :: Proxy f)

class HasEnumerableConstructors a where
  listConstructors :: a -> [String]
  allConstructors :: Proxy a -> [String]
  default listConstructors :: (Generic a, HasEnumerableConstructors1 (Rep a)) => a -> [String]
  listConstructors = forall (f :: * -> *) p.
HasEnumerableConstructors1 f =>
f p -> [String]
listConstructors1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from

  default allConstructors :: (Generic a, HasEnumerableConstructors1 (Rep a)) => Proxy a -> [String]
  allConstructors Proxy a
_ = forall (f :: * -> *).
HasEnumerableConstructors1 f =>
Proxy f -> [String]
allConstructors1 (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Rep a))

instance {-# OVERLAPPABLE #-} HasEnumerableConstructors a where
  listConstructors :: a -> [String]
listConstructors a
_ = []
  allConstructors :: Proxy a -> [String]
allConstructors Proxy a
_ = []

instance HasEnumerableConstructors a => HasEnumerableConstructors [a] where
  listConstructors :: [a] -> [String]
listConstructors = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. HasEnumerableConstructors a => a -> [String]
listConstructors
  allConstructors :: Proxy [a] -> [String]
allConstructors Proxy [a]
_ = forall a. HasEnumerableConstructors a => Proxy a -> [String]
allConstructors (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance HasEnumerableConstructors a => HasEnumerableConstructors (Maybe a) where
  listConstructors :: Maybe a -> [String]
listConstructors = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. HasEnumerableConstructors a => a -> [String]
listConstructors
  allConstructors :: Proxy (Maybe a) -> [String]
allConstructors Proxy (Maybe a)
_ = forall a. HasEnumerableConstructors a => Proxy a -> [String]
allConstructors (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance (HasEnumerableConstructors a, HasEnumerableConstructors b) => HasEnumerableConstructors (Either a b) where
  listConstructors :: Either a b -> [String]
listConstructors = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasEnumerableConstructors a => a -> [String]
listConstructors forall a. HasEnumerableConstructors a => a -> [String]
listConstructors
  allConstructors :: Proxy (Either a b) -> [String]
allConstructors Proxy (Either a b)
_ = forall a. HasEnumerableConstructors a => Proxy a -> [String]
allConstructors (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) forall a. [a] -> [a] -> [a]
++ forall a. HasEnumerableConstructors a => Proxy a -> [String]
allConstructors (forall {k} (t :: k). Proxy t
Proxy :: Proxy b)