    -- |
    -- Module      : Generics.Deriving.Default
    -- Description : Default implementations of generic classes
    -- License     : BSD-3-Clause
    --
    -- Maintainer  : generics@haskell.org
    -- Stability   : experimental
    -- Portability : non-portable
    --
    -- GHC 8.6 introduced the
    -- @<https://downloads.haskell.org/~ghc/8.6.3/docs/html/users_guide/glasgow_exts.html?highlight=derivingvia#extension-DerivingVia DerivingVia>@
    -- language extension, which means a typeclass instance can be derived from
    -- an existing instance for an isomorphic type. Any newtype is isomorphic
    -- to the underlying type. By implementing a typeclass once for the newtype,
    -- it is possible to derive any typeclass for any type with a 'Generic' instance.
    --
    -- For a number of classes, there are sensible default instantiations. In
    -- older GHCs, these can be supplied in the class definition, using the
    -- @<https://downloads.haskell.org/~ghc/8.6.3/docs/html/users_guide/glasgow_exts.html?highlight=defaultsignatures#extension-DefaultSignatures DefaultSignatures>@
    -- extension. However, only one default can be provided! With
    -- @<https://downloads.haskell.org/~ghc/8.6.3/docs/html/users_guide/glasgow_exts.html?highlight=derivingvia#extension-DerivingVia DerivingVia>@
    -- it is now possible to choose from many
    -- default instantiations.
    --
    -- This package contains a number of such classes. This module demonstrates
    -- how one might create a family of newtypes ('Default', 'Default1') for
    -- which such instances are defined.
    --
    -- One might then use
    -- @<https://downloads.haskell.org/~ghc/8.6.3/docs/html/users_guide/glasgow_exts.html?highlight=derivingvia#extension-DerivingVia DerivingVia>@
    -- as follows. The implementations of the data types are elided here (they
    -- are irrelevant). For most cases, either the deriving clause with the
    -- data type definition or the standalone clause will work (for some types
    -- it is necessary to supply the context explicitly using the latter form).
    -- See the source of this module for the implementations of instances for
    -- the 'Default' family of newtypes and the source of the test suite for
    -- some types which derive instances via these wrappers.

    {-# LANGUAGE CPP #-}
    #if __GLASGOW_HASKELL__ >= 701
    {-# LANGUAGE DefaultSignatures #-}
    # if __GLASGOW_HASKELL__ >= 704
    {-# LANGUAGE Safe #-}
    # else
    {-# LANGUAGE Trustworthy #-}
    # endif
    #endif
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE UndecidableInstances #-}

    module Generics.Deriving.Default
      ( -- * Kind @*@ (aka @Type@)

        -- $default

        Default(..)

      , -- * Kind @* -> *@ (aka @Type -> Type@)

        -- $default1

        Default1(..)

        -- * Other kinds

        -- $other-kinds
      ) where

    #if !(MIN_VERSION_base(4,8,0))
    import Control.Applicative ((<$>))
    #endif
    import Control.Monad (liftM)

    import Generics.Deriving.Base
    import Generics.Deriving.Copoint
    import Generics.Deriving.Enum
    import Generics.Deriving.Eq
    import Generics.Deriving.Foldable
    import Generics.Deriving.Functor
    import Generics.Deriving.Monoid
    import Generics.Deriving.Semigroup
    import Generics.Deriving.Show
    import Generics.Deriving.Traversable
    import Generics.Deriving.Uniplate

    -- $default
    --
    -- For classes which take an argument of kind 'Data.Kind.Type', use
    -- 'Default'. An example of this class from @base@ would be 'Eq', or
    -- 'Generic'.
    --
    -- These examples use 'GShow' and 'GEq'; they are interchangeable.
    --
    -- @
    -- data MyType = …
    --  deriving ('Generic')
    --  deriving ('GEq') via ('Default' MyType)
    --
    -- deriving via ('Default' MyType) instance 'GShow' MyType
    -- @
    --
    -- Instances may be parameterized by type variables.
    --
    -- @
    -- data MyType1 a = …
    --  deriving ('Generic')
    --  deriving ('GShow') via ('Default' (MyType1 a))
    --
    -- deriving via 'Default' (MyType1 a) instance 'GEq' a => 'GEq' (MyType1 a)
    -- @
    --
    -- These types both require instances for 'Generic'. This is because the
    -- implementations of 'geq' and 'gshowsPrec' for @'Default' b@ have a @'Generic'
    -- b@ constraint, i.e. the type corresponding to @b@ require a 'Generic'
    -- instance. For these two types, that means instances for @'Generic' MyType@
    -- and @'Generic' (MyType1 a)@ respectively.
    --
    -- It also means the 'Generic' instance is not needed when there is already
    -- a generic instance for the type used to derive the relevant instances.
    -- For an example, see the documentation of the 'GShow' instance for
    -- 'Default', below.

    -- | This newtype wrapper can be used to derive default instances for
    -- classes taking an argument of kind 'Data.Kind.Type'.
    newtype Default a = Default { forall a. Default a -> a
    unDefault :: a }

    -- $default1
    --
    -- For classes which take an argument of kind @'Data.Kind.Type' ->
    -- 'Data.Kind.Type'@, use 'Default1'.  An example of this class from @base@
    -- would be 'Data.Functor.Classes.Eq1', or 'Generic1'.
    --
    -- Unlike for @MyType1@, there can be no implementation of these classes for @MyType :: 'Data.Kind.Type'@.
    --
    -- @
    -- data MyType1 a = …
    --  deriving ('Generic1')
    --  deriving ('GFunctor') via ('Default1' MyType1)
    --
    -- deriving via ('Default1' MyType1) instance 'GFoldable' MyType1
    -- @
    --
    -- Note that these instances require a @'Generic1' MyType1@ constraint as
    -- 'gmap' and 'gfoldMap' have @'Generic1' a@ constraints on the
    -- implementations for @'Default1' a@.

    -- | This newtype wrapper can be used to derive default instances for
    -- classes taking an argument of kind @'Data.Kind.Type' -> 'Data.Kind.Type'@.
    newtype Default1 f a = Default1 { forall (f :: * -> *) a. Default1 f a -> f a
    unDefault1 :: f a }

    -- $other-kinds
    --
    -- These principles extend to classes taking arguments of other kinds.

    --------------------------------------------------------------------------------
    -- Eq
    --------------------------------------------------------------------------------

    instance (Generic a, GEq' (Rep a)) => GEq (Default a) where
      -- geq :: Default a -> Default a -> Bool
      Default a
    x geq :: Default a -> Default a -> Bool
    `geq` Default a
    y = a
    x a -> a -> Bool
    forall a. (Generic a, GEq' (Rep a)) => a -> a -> Bool
    `geqdefault` a
    y

    --------------------------------------------------------------------------------
    -- Enum
    --------------------------------------------------------------------------------

    -- | The 'Enum' class in @base@ is slightly different; it comprises 'toEnum' and
    -- 'fromEnum'. "Generics.Deriving.Enum" provides functions 'toEnumDefault'
    -- and 'fromEnumDefault'.
    instance (Generic a, GEq a, Enum' (Rep a)) => GEnum (Default a) where
      -- genum :: [Default a]
      genum :: [Default a]
    genum = a -> Default a
    forall a. a -> Default a
    Default (a -> Default a) -> (Rep a Any -> a) -> Rep a Any -> Default a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rep a Any -> a
    forall a x. Generic a => Rep a x -> a
    forall x. Rep a x -> a
    to (Rep a Any -> Default a) -> [Rep a Any] -> [Default a]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Rep a Any]
    forall a. [Rep a a]
    forall {k} (f :: k -> *) (a :: k). Enum' f => [f a]
    enum'

    --------------------------------------------------------------------------------
    -- Show
    --------------------------------------------------------------------------------

    -- | For example, with this type:
    --
    -- @
    -- newtype TestShow = TestShow 'Bool'
    --   deriving ('GShow') via ('Default' 'Bool')
    -- @
    --
    -- 'gshow' for @TestShow@ would produce the same string as `gshow` for
    -- 'Bool'.
    --
    -- In this example, @TestShow@ requires no 'Generic' instance, as the
    -- constraint on 'gshowsPrec' from @'Default' 'Bool'@ is @'Generic' 'Bool'@.
    --
    -- In general, when using a newtype wrapper, the instance can be derived
    -- via the wrapped type, as here (via @'Default' 'Bool'@ rather than @'Default'
    -- TestShow@).
    instance (Generic a, GShow' (Rep a)) => GShow (Default a) where
      -- gshowsPrec :: Int -> Default a -> ShowS
      gshowsPrec :: Int -> Default a -> ShowS
    gshowsPrec Int
    n (Default a
    x) = Int -> a -> ShowS
    forall a. (Generic a, GShow' (Rep a)) => Int -> a -> ShowS
    gshowsPrecdefault Int
    n a
    x

    --------------------------------------------------------------------------------
    -- Semigroup
    --------------------------------------------------------------------------------

    -- | Semigroups often have many sensible implementations of
    -- 'Data.Semigroup.<>' / 'gsappend', and therefore no sensible default.
    -- Indeed, there is no 'GSemigroup'' instance for representations of sum
    -- types.
    --
    -- In other cases, one may wish to use the existing wrapper newtypes in
    -- @base@, such as the following (using 'Data.Semigroup.First'):
    --
    -- @
    -- newtype FirstSemigroup = FirstSemigroup 'Bool'
    --   deriving stock ('Eq', 'Show')
    --   deriving ('GSemigroup') via ('Data.Semigroup.First' 'Bool')
    -- @
    --
    instance (Generic a, GSemigroup' (Rep a)) => GSemigroup (Default a) where
      -- gsappend :: Default a -> Default a -> Default a
      Default a
    x gsappend :: Default a -> Default a -> Default a
    `gsappend` Default a
    y = a -> Default a
    forall a. a -> Default a
    Default (a -> Default a) -> a -> Default a
    forall a b. (a -> b) -> a -> b
    $ a
    x a -> a -> a
    forall a. (Generic a, GSemigroup' (Rep a)) => a -> a -> a
    `gsappenddefault` a
    y

    --------------------------------------------------------------------------------
    -- Monoid
    --------------------------------------------------------------------------------

    instance (Generic a, GMonoid' (Rep a)) => GMonoid (Default a) where
      -- gmempty :: Default a
      gmempty :: Default a
    gmempty = a -> Default a
    forall a. a -> Default a
    Default a
    forall a. (Generic a, GMonoid' (Rep a)) => a
    gmemptydefault

      -- gmappend :: Default a -> Default a -> Default a
      Default a
    x gmappend :: Default a -> Default a -> Default a
    `gmappend` Default a
    y = a -> Default a
    forall a. a -> Default a
    Default (a -> Default a) -> a -> Default a
    forall a b. (a -> b) -> a -> b
    $ a
    x a -> a -> a
    forall a. (Generic a, GMonoid' (Rep a)) => a -> a -> a
    `gmappenddefault` a
    y

    --------------------------------------------------------------------------------
    -- Uniplate
    --------------------------------------------------------------------------------

    instance (Generic a, Uniplate' (Rep a) a, Context' (Rep a) a) => Uniplate (Default a) where

      -- children   ::                                             Default a  ->   [Default a]
      -- context    ::                             Default a   -> [Default a] ->    Default a
      -- descend    ::            (Default a ->    Default a)  ->  Default a  ->    Default a
      -- descendM   :: Monad m => (Default a -> m (Default a)) ->  Default a  -> m (Default a)
      -- transform  ::            (Default a ->    Default a)  ->  Default a  ->    Default a
      -- transformM :: Monad m => (Default a -> m (Default a)) ->  Default a  -> m (Default a)

      children :: Default a -> [Default a]
    children     (Default a
    x)    =       a -> Default a
    forall a. a -> Default a
    Default (a -> Default a) -> [a] -> [Default a]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> [a]
    forall a. (Generic a, Uniplate' (Rep a) a) => a -> [a]
    childrendefault    a
    x
      context :: Default a -> [Default a] -> Default a
    context      (Default a
    x) [Default a]
    ys =       a -> Default a
    forall a. a -> Default a
    Default  (a -> Default a) -> a -> Default a
    forall a b. (a -> b) -> a -> b
    $  a -> [a] -> a
    forall a. (Generic a, Context' (Rep a) a) => a -> [a] -> a
    contextdefault     a
    x    (Default a -> a
    forall a. Default a -> a
    unDefault (Default a -> a) -> [Default a] -> [a]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Default a]
    ys)
      descend :: (Default a -> Default a) -> Default a -> Default a
    descend    Default a -> Default a
    f (Default a
    x)    =       a -> Default a
    forall a. a -> Default a
    Default  (a -> Default a) -> a -> Default a
    forall a b. (a -> b) -> a -> b
    $  (a -> a) -> a -> a
    forall a. (Generic a, Uniplate' (Rep a) a) => (a -> a) -> a -> a
    descenddefault          (Default a -> a
    forall a. Default a -> a
    unDefault (Default a -> a) -> (a -> Default a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Default a -> Default a
    f (Default a -> Default a) -> (a -> Default a) -> a -> Default a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Default a
    forall a. a -> Default a
    Default) a
    x
      descendM :: forall (m :: * -> *).
    Monad m =>
    (Default a -> m (Default a)) -> Default a -> m (Default a)
    descendM   Default a -> m (Default a)
    f (Default a
    x)    = (a -> Default a) -> m a -> m (Default a)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM a -> Default a
    forall a. a -> Default a
    Default  (m a -> m (Default a)) -> m a -> m (Default a)
    forall a b. (a -> b) -> a -> b
    $  (a -> m a) -> a -> m a
    forall a (m :: * -> *).
    (Generic a, Uniplate' (Rep a) a, Monad m) =>
    (a -> m a) -> a -> m a
    descendMdefault   ((Default a -> a) -> m (Default a) -> m a
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Default a -> a
    forall a. Default a -> a
    unDefault (m (Default a) -> m a) -> (a -> m (Default a)) -> a -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Default a -> m (Default a)
    f (Default a -> m (Default a))
    -> (a -> Default a) -> a -> m (Default a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Default a
    forall a. a -> Default a
    Default) a
    x
      transform :: (Default a -> Default a) -> Default a -> Default a
    transform  Default a -> Default a
    f (Default a
    x)    =       a -> Default a
    forall a. a -> Default a
    Default  (a -> Default a) -> a -> Default a
    forall a b. (a -> b) -> a -> b
    $  (a -> a) -> a -> a
    forall a. (Generic a, Uniplate' (Rep a) a) => (a -> a) -> a -> a
    transformdefault        (Default a -> a
    forall a. Default a -> a
    unDefault (Default a -> a) -> (a -> Default a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Default a -> Default a
    f (Default a -> Default a) -> (a -> Default a) -> a -> Default a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Default a
    forall a. a -> Default a
    Default) a
    x
      transformM :: forall (m :: * -> *).
    Monad m =>
    (Default a -> m (Default a)) -> Default a -> m (Default a)
    transformM Default a -> m (Default a)
    f (Default a
    x)    = (a -> Default a) -> m a -> m (Default a)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM a -> Default a
    forall a. a -> Default a
    Default  (m a -> m (Default a)) -> m a -> m (Default a)
    forall a b. (a -> b) -> a -> b
    $  (a -> m a) -> a -> m a
    forall a (m :: * -> *).
    (Generic a, Uniplate' (Rep a) a, Monad m) =>
    (a -> m a) -> a -> m a
    transformMdefault ((Default a -> a) -> m (Default a) -> m a
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Default a -> a
    forall a. Default a -> a
    unDefault (m (Default a) -> m a) -> (a -> m (Default a)) -> a -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Default a -> m (Default a)
    f (Default a -> m (Default a))
    -> (a -> Default a) -> a -> m (Default a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Default a
    forall a. a -> Default a
    Default) a
    x

    --------------------------------------------------------------------------------
    -- Functor
    --------------------------------------------------------------------------------

    instance (Generic1 f, GFunctor' (Rep1 f)) => GFunctor (Default1 f) where
      -- gmap :: (a -> b) -> (Default1 f) a -> (Default1 f) b
      gmap :: forall a b. (a -> b) -> Default1 f a -> Default1 f b
    gmap a -> b
    f (Default1 f a
    fx) = f b -> Default1 f b
    forall (f :: * -> *) a. f a -> Default1 f a
    Default1 (f b -> Default1 f b) -> f b -> Default1 f b
    forall a b. (a -> b) -> a -> b
    $ (a -> b) -> f a -> f b
    forall (f :: * -> *) a b.
    (Generic1 f, GFunctor' (Rep1 f)) =>
    (a -> b) -> f a -> f b
    gmapdefault a -> b
    f f a
    fx

    --------------------------------------------------
    -- Copoint
    --------------------------------------------------

    instance (Generic1 f, GCopoint' (Rep1 f)) => GCopoint (Default1 f) where
      -- gcopoint :: Default1 f a -> a
      gcopoint :: forall a. Default1 f a -> a
    gcopoint = f a -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault (f a -> a) -> (Default1 f a -> f a) -> Default1 f a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Default1 f a -> f a
    forall (f :: * -> *) a. Default1 f a -> f a
    unDefault1

    --------------------------------------------------
    -- Foldable
    --------------------------------------------------

    instance (Generic1 t, GFoldable' (Rep1 t)) => GFoldable (Default1 t) where
      -- gfoldMap :: Monoid m => (a -> m) -> Default1 t a -> m
      gfoldMap :: forall m a. Monoid m => (a -> m) -> Default1 t a -> m
    gfoldMap a -> m
    f (Default1 t a
    tx) = (a -> m) -> t a -> m
    forall (t :: * -> *) m a.
    (Generic1 t, GFoldable' (Rep1 t), Monoid m) =>
    (a -> m) -> t a -> m
    gfoldMapdefault a -> m
    f t a
    tx

    --------------------------------------------------
    -- Traversable
    --------------------------------------------------

    instance (Generic1 t, GFunctor' (Rep1 t), GFoldable' (Rep1 t), GTraversable' (Rep1 t)) => GTraversable (Default1 t) where
      -- gtraverse :: Applicative f => (a -> f b) -> Default1 t a -> f (Default1 t b)
      gtraverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Default1 t a -> f (Default1 t b)
    gtraverse a -> f b
    f (Default1 t a
    fx) = t b -> Default1 t b
    forall (f :: * -> *) a. f a -> Default1 f a
    Default1 (t b -> Default1 t b) -> f (t b) -> f (Default1 t b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (a -> f b) -> t a -> f (t b)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Generic1 t, GTraversable' (Rep1 t), Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    gtraversedefault a -> f b
    f t a
    fx