{-# LANGUAGE DataKinds    #-}
{-# LANGUAGE Trustworthy  #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_GHC -Wno-orphans #-}

{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Copyright   :  Kazuki Okamoto
-- License     :  see LICENSE
-- Maintainer  :  kazuki.okamoto@kakkun61.com
-- Stability   :  experimental
-- Portability :  GHC
--
-- Single homotuples.

module Data.Tuple.Homotuple.Identity () where

import Data.Functor.Identity (Identity (Identity))
import Data.Tuple.Homotuple  (Homotuple, errorLengthMismatch)
import GHC.Exts              (IsList (Item, fromList, toList))

type instance Homotuple 1 a = Identity a

instance IsList (Identity a) where
  type Item (Identity a) = a
  fromList :: [Item (Identity a)] -> Identity a
fromList [Item (Identity a)
a] = a -> Identity a
forall a. a -> Identity a
Identity a
Item (Identity a)
a
  fromList [Item (Identity a)]
_   = Identity a
forall a. HasCallStack => a
errorLengthMismatch
  toList :: Identity a -> [Item (Identity a)]
toList (Identity a
a) = [a
Item (Identity a)
a]