{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}

#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif

#if __GLASGOW_HASKELL__ >= 705
{-# LANGUAGE PolyKinds #-}
#endif

{- |
Module      :  Generics.Deriving.ConNames
Copyright   :  (c) 2012 University of Oxford
License     :  BSD3

Maintainer  :  generics@haskell.org
Stability   :  experimental
Portability :  non-portable

Summary: Return the name of all the constructors of a type.
-}

module Generics.Deriving.ConNames (

    -- * Functionality for retrieving the names of the possible contructors
    --   of a type or the constructor name of a given value
    ConNames(..), conNames, conNameOf

  ) where

import Generics.Deriving.Base


class ConNames f where
    gconNames  :: f a -> [String]
    gconNameOf :: f a -> String

instance (ConNames f, ConNames g) => ConNames (f :+: g) where
    gconNames :: (:+:) f g a -> [String]
gconNames ((:+:) f g a
_ :: (f :+: g) a) = f a -> [String]
forall k (f :: k -> *) (a :: k). ConNames f => f a -> [String]
gconNames (f a
forall a. HasCallStack => a
undefined :: f a) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                                   g a -> [String]
forall k (f :: k -> *) (a :: k). ConNames f => f a -> [String]
gconNames (g a
forall a. HasCallStack => a
undefined :: g a)

    gconNameOf :: (:+:) f g a -> String
gconNameOf (L1 f a
x) = f a -> String
forall k (f :: k -> *) (a :: k). ConNames f => f a -> String
gconNameOf f a
x
    gconNameOf (R1 g a
x) = g a -> String
forall k (f :: k -> *) (a :: k). ConNames f => f a -> String
gconNameOf g a
x

instance (ConNames f) => ConNames (D1 c f) where
    gconNames :: D1 c f a -> [String]
gconNames (D1 c f a
_ :: (D1 c f) a) = f a -> [String]
forall k (f :: k -> *) (a :: k). ConNames f => f a -> [String]
gconNames (f a
forall a. HasCallStack => a
undefined :: f a)

    gconNameOf :: D1 c f a -> String
gconNameOf (M1 f a
x) = f a -> String
forall k (f :: k -> *) (a :: k). ConNames f => f a -> String
gconNameOf f a
x

instance (Constructor c) => ConNames (C1 c f) where
    gconNames :: C1 c f a -> [String]
gconNames C1 c f a
x = [C1 c f a -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName C1 c f a
x]

    gconNameOf :: C1 c f a -> String
gconNameOf C1 c f a
x = C1 c f a -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName C1 c f a
x


-- We should never need any other instances.


-- | Return the name of all the constructors of the type of the given term.
conNames :: (Generic a, ConNames (Rep a)) => a -> [String]
conNames :: a -> [String]
conNames a
x = Rep a Any -> [String]
forall k (f :: k -> *) (a :: k). ConNames f => f a -> [String]
gconNames (Rep a Any
forall a. HasCallStack => a
undefined Rep a Any -> Rep a Any -> Rep a Any
forall a. a -> a -> a
`asTypeOf` (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
x))

-- | Return the name of the constructor of the given term
conNameOf :: (ConNames (Rep a), Generic a) => a -> String
conNameOf :: a -> String
conNameOf a
x = Rep a Any -> String
forall k (f :: k -> *) (a :: k). ConNames f => f a -> String
gconNameOf (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
x)