    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE InstanceSigs #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE PolyKinds #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE StandaloneDeriving #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# OPTIONS_GHC -Wno-orphans #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Singletons.Prelude.Identity
    -- Copyright   :  (C) 2018 Ryan Scott
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    -- Exports the promoted and singled versions of the 'Identity' data type.
    --
    -----------------------------------------------------------------------------

    module Data.Singletons.Prelude.Identity (
      -- * The 'Identity' singleton
      Sing(SIdentity, sRunIdentity),
      SIdentity, RunIdentity,

      -- * Defunctionalization symbols
      IdentitySym0, IdentitySym1,
      RunIdentitySym0, RunIdentitySym1
      ) where

    import Control.Applicative
    import Data.Foldable (Foldable(..))
    import Data.Functor.Identity
    import Data.Singletons.Prelude.Base hiding (Foldr, FoldrSym0, sFoldr)
    import Data.Singletons.Prelude.Enum
    import Data.Singletons.Prelude.Eq
    import Data.Singletons.Prelude.Foldable
    import Data.Singletons.Prelude.Instances hiding (Foldl, sFoldl)
    import Data.Singletons.Prelude.Monad.Internal
    import Data.Singletons.Prelude.Monoid
    import Data.Singletons.Prelude.Num
    import Data.Singletons.Prelude.Ord
    import Data.Singletons.Prelude.Semigroup.Internal
    import Data.Singletons.Prelude.Show
    import Data.Singletons.Single

    $(singletonsOnly [d|
      -- deriving instance Enum a => Enum (Identity a)
      instance Enum a => Enum (Identity a) where
        succ (Identity x)     = Identity (succ x)
        pred (Identity x)     = Identity (pred x)
        toEnum i              = Identity (toEnum i)
        fromEnum (Identity x) = fromEnum x
        enumFromTo (Identity x) (Identity y) = map Identity (enumFromTo   x y)
        enumFromThenTo (Identity x) (Identity y) (Identity z) =
            map Identity (enumFromThenTo x y z)

      -- deriving instance Monoid a => Monoid (Identity a)
      instance Monoid a => Monoid (Identity a) where
        mempty = Identity mempty

      -- deriving instance Num a => Num (Identity a)
      instance Num a => Num (Identity a) where
        Identity x + Identity y = Identity (x + y)
        Identity x - Identity y = Identity (x - y)
        Identity x * Identity y = Identity (x * y)
        negate (Identity x)     = Identity (negate x)
        abs    (Identity x)     = Identity (abs    x)
        signum (Identity x)     = Identity (signum x)
        fromInteger n           = Identity (fromInteger n)

      -- deriving instance Semigroup a => Semigroup (Identity a)
      instance Semigroup a => Semigroup (Identity a) where
        Identity x <> Identity y = Identity (x <> y)

      -- -| This instance would be equivalent to the derived instances of the
      -- 'Identity' newtype if the 'runIdentity' field were removed
      instance Show a => Show (Identity a) where
        showsPrec d (Identity x) = showParen (d > 10) $
          showString "Identity " . showsPrec 11 x

      deriving instance Functor Identity

      instance Foldable Identity where
          foldMap f (Identity x)  = f x

          elem x (Identity y)     = x == y
          foldl f z (Identity x)  = f z x
          foldl' f z (Identity x) = f z x
          foldl1 _ (Identity x)   = x
          foldr f z (Identity x)  = f x z
          foldr'                  = foldr
          foldr1 _ (Identity x)   = x
          length _                = 1
          maximum (Identity x)    = x
          minimum (Identity x)    = x
          null _                  = False
          product (Identity x)    = x
          sum (Identity x)        = x
          toList (Identity x)     = [x]

      instance Applicative Identity where
        pure = Identity
        Identity f <*> Identity x = Identity (f x)
        liftA2 f (Identity x) (Identity y) = Identity (f x y)

      instance Monad Identity where
        Identity m >>= k = k m
      |])