{-# LANGUAGE Trustworthy, CPP, MagicHash, UnboxedTuples, BangPatterns #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeOperators #-}

{- |
    Module      :  SDP.Unboxed
    Copyright   :  (c) Andrey Mulik 2019-2021
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  non-portable (GHC extensions)

    "SDP.Unboxed" provide service class 'Unboxed', that needed for
    "SDP.Prim.SBytes"-based structures.
-}
module SDP.Unboxed
(
  -- * Unboxed
  Unboxed (..), cloneUnboxed#, cloneUnboxedM#, thawUnboxed#, freezeUnboxed#,

  -- ** Kind @(Type -> Type)@ proxies
  fromProxy, psizeof#, psizeof, pnewUnboxed, pcopyUnboxed, pcopyUnboxedM,
  pcloneUnboxed, pcloneUnboxedM, pthawUnboxed, pfreezeUnboxed,

  -- ** Kind @(Type -> Type -> Type)@ proxies
  fromProxy1, pnewUnboxed1, pcloneUnboxed1, pcopyUnboxed1, pcopyUnboxedM1,
  cloneUnboxed1#, pcloneUnboxedM1,

  -- Wrap helper
  Wrap (..), lzero#, single#, fromList#, fromFoldable#, fromListN#,
  newLinear#, newLinearN#, fromFoldableM#, concat#, pconcat
)
where

import Prelude ()
import SDP.SafePrelude
import SDP.Nullable
import SDP.Finite
import SDP.Shape
import SDP.Ratio

import GHC.Stable
import GHC.Base   hiding ( (.), foldr )
import GHC.Word
import GHC.Int
import GHC.Ptr
import GHC.ST

import Data.Complex

import Foreign.C.Types

#include "MachDeps.h"

default ()

--------------------------------------------------------------------------------

{- |
  'Unboxed' is a layer between untyped raw data and parameterized unboxed data
  structures. Also it prevents direct interaction with primitives.
-}
class (Eq e) => Unboxed e
  where
    {-# MINIMAL (sizeof#|sizeof), (!#), (!>#), writeByteArray#, newUnboxed #-}

    {- |
      @sizeof e n@ returns the length (in bytes) of primitive, where @n@ - count
      of elements, @e@ - type parameter.
    -}
    {-# INLINE sizeof #-}
    sizeof :: e -> Int -> Int
    sizeof e (I# c#) = I# (sizeof# e c#)

    -- | 'sizeof#' is unboxed 'sizeof'.
    {-# INLINE sizeof# #-}
    sizeof# :: e -> Int# -> Int#
    sizeof# e c# = case sizeof e (I# c#) of I# n# -> n#

    -- | Unsafe 'ByteArray#' reader with overloaded result type.
    (!#) :: ByteArray# -> Int# -> e

    -- | Unsafe 'MutableByteArray#' reader with overloaded result type.
    (!>#) :: MutableByteArray# s -> Int# -> State# s -> (# State# s, e #)

    -- | Unsafe 'MutableByteArray#' writer.
    writeByteArray# :: MutableByteArray# s -> Int# -> e -> State# s -> State# s

    {-# INLINE fillByteArray# #-}
    -- | Procedure for filling the array with the default value (like calloc).
    fillByteArray# :: MutableByteArray# s -> Int# -> e -> State# s -> State# s
    fillByteArray# mbytes# n# e = I# n# > 0 ? go (n# -# 1#) $ \ s1# -> s1#
      where
        go 0# s2# = writeByteArray# mbytes# 0# e s2#
        go c# s2# = go (c# -# 1#) (writeByteArray# mbytes# c# e s2#)

    {- |
      'newUnboxed' creates new 'MutableByteArray#' of given count of elements.
      First argument used as type variable.
    -}
    newUnboxed :: e -> Int# -> State# s -> (# State# s, MutableByteArray# s #)

    {-# INLINE newUnboxed' #-}
    {- |
      'newUnboxed'' is version of 'newUnboxed', that use first argument as
      initial value. May fail when trying to write 'error' or 'undefined'.
    -}
    newUnboxed' :: e -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
    newUnboxed' e n# = \ s1# -> case newByteArray# (sizeof# e n#) s1# of
      (# s2#, mbytes# #) -> case fillByteArray# mbytes# n# e s2# of
        s3# -> (# s3#, mbytes# #)

    {- |
      @'copyUnboxed#' e bytes\# o1\# mbytes\# o2\# n\#@ unsafely writes elements
      from @bytes\#@ to @mbytes\#@, where o1\# and o2\# - offsets (element
      count), @n\#@ - count of elements to copy.
    -}
    copyUnboxed# :: e -> ByteArray# -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
    copyUnboxed# e bytes# o1# mbytes# o2# n# = copyByteArray# bytes# (sizeof# e o1#) mbytes# (sizeof# e o2#) (sizeof# e n#)

    {- |
      @'copyUnboxedM#' e msrc\# o1\# mbytes\# o2\# n\#@ unsafely writes elements
      from @msrc\#@ to @mbytes\#@, where o1\# and o2\# - offsets (element
      count), @n\#@ - count of elements to copy.
    -}
    copyUnboxedM# :: e -> MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
    copyUnboxedM# e msrc# o1# mbytes# o2# n# = copyMutableByteArray# msrc# (sizeof# e o1#) mbytes# (sizeof# e o2#) (sizeof# e n#)

    {- |
      @'hashUnboxedWith' e len# off# bytes# salt@ returns @bytes#@ @FNV-1@ hash,
      where @off#@ and @len#@ is offset and length (in elements).

      Note: the standard definition of this function is written in Haskell using
      low-level functions, but this implementation mayn't be as efficient as the
      foreign procedure in the @hashable@ package.
    -}
    hashUnboxedWith :: e -> Int# -> Int# -> ByteArray# -> Int# -> Int#
    hashUnboxedWith e len# off# bytes# = go (sizeof# e off#) (sizeof# e len#)
      where
        go _  0# salt# = salt#
        go o# n# salt# = go (o# +# 1#) (n# -# 1#) (word2Int# hash#)
          where
            prod# = int2Word# (salt# *# 16777619#)
            elem# = indexWord8Array# bytes# o#
            hash# = prod# `xor#` elem#

--------------------------------------------------------------------------------

{- Unboxed helpers. -}

{- |
  @since 0.2
  @cloneUnboxed# e bytes# o# c#@ creates new @c#@-element length immutable slice
  of @bytes#@ beginning from @o#@-th element.
-}
cloneUnboxed# :: (Unboxed e) => e -> ByteArray# -> Int# -> Int# -> ByteArray#
cloneUnboxed# e bytes# o# c# = unwrap $ runST $ ST $
  \ s1# -> case newUnboxed e c# s1# of
    (# s2#, mbytes# #) -> case copyUnboxed# e bytes# o# mbytes# 0# c# s2# of
      s3# -> case unsafeFreezeByteArray# mbytes# s3# of
        (# s4#, bytes'# #) -> (# s4#, (Wrap bytes'#) #)

{- |
  @since 0.2.1
  @cloneUnboxedM# e mbytes# o# c#@ creates new @c#@-element length mutable slice
  of @bytes#@ beginning from @o#@-th element.
-}
cloneUnboxedM# :: (Unboxed e) => e -> MutableByteArray# s -> Int# -> Int# ->
  State# s -> (# State# s, MutableByteArray# s #)
cloneUnboxedM# e mbytes# o# n# = \ s1# -> case newByteArray# (sizeof# e n#) s1# of
  (# s2#, copy# #) -> case copyUnboxedM# e mbytes# o# copy# 0# n# s2# of
    s3# -> (# s3#, copy# #)

{- |
  @since 0.2.1
  @'thawUnboxed#' e bytes# c#@ creates new @sizeof# e c#@ bytes length
  'MutableByteArray#' and copy @bytes#@ to it.
-}
thawUnboxed# :: (Unboxed e) => e -> ByteArray# -> Int# ->
  State# s -> (# State# s, MutableByteArray# s #)
thawUnboxed# e bytes# c# = \ s1# -> case newByteArray# n# s1# of
    (# s2#, mbytes# #) -> case copyByteArray# bytes# 0# mbytes# 0# n# s2# of
      s3# -> (# s3#, mbytes# #)
  where
    n# = sizeof# e c#

{- |
  @since 0.2.1
  @'freezeUnboxed#' e mbytes# c#@ creates new @sizeof# e c#@ bytes length
  'ByteArray#' and copy @mbytes#@ to it.
-}
freezeUnboxed# :: (Unboxed e) => e -> MutableByteArray# s -> Int# ->
  State# s -> (# State# s, ByteArray# #)
freezeUnboxed# e mbytes# n# = \ s1# -> case cloneUnboxedM# e mbytes# 0# n# s1# of
  (# s2#, copy# #) -> unsafeFreezeByteArray# copy# s2#

--------------------------------------------------------------------------------

{- Rank 1 Unboxed proxies. -}

-- | Returns 'undefined' of suitable type.
fromProxy :: proxy e -> e
fromProxy =  const undefined

{- |
  @since 0.2.1
  'psizeof#' is proxy version of 'sizeof#'.
-}
psizeof# :: (Unboxed e) => proxy e -> Int# -> Int#
psizeof# =  sizeof# . fromProxy

{- |
  @since 0.2
  'psizeof' is proxy version of 'sizeof'.
-}
psizeof :: (Unboxed e) => proxy e -> Int -> Int
psizeof =  sizeof . fromProxy

{- |
  @since 0.2
  Kind @(Type -> Type)@ proxy version of 'newUnboxed'.
-}
pnewUnboxed :: (Unboxed e) => proxy e -> Int# ->
  State# s -> (# State# s, MutableByteArray# s #)
pnewUnboxed =  newUnboxed . fromProxy

{- |
  @since 0.2
  Kind @(Type -> Type)@ proxy version if 'copyUnboxed#'.
-}
pcopyUnboxed :: (Unboxed e) => proxy e -> ByteArray# -> Int# ->
  MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
pcopyUnboxed =  copyUnboxed# . fromProxy

{- |
  @since 0.2
  Kind @(Type -> Type)@ proxy version if 'copyUnboxedM#'.
-}
pcopyUnboxedM :: (Unboxed e) => proxy e -> MutableByteArray# s -> Int# ->
  MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
pcopyUnboxedM =  copyUnboxedM# . fromProxy

{- |
  @since 0.2
  Kind @(Type -> Type)@ proxy version of 'cloneUnboxed#'.
-}
cloneUnboxed1# :: (Unboxed e) => proxy e -> ByteArray# -> Int# -> Int# -> ByteArray#
cloneUnboxed1# =  cloneUnboxed# . fromProxy

{- |
  @since 0.2.1
  Same as @sdp-0.2@ 'cloneUnboxed1#'. Use only if you don't need @sdp-0.2@
  compatibility.
-}
pcloneUnboxed :: (Unboxed e) => proxy e -> ByteArray# -> Int# -> Int# -> ByteArray#
pcloneUnboxed =  cloneUnboxed1#

{- |
  @since 0.2.1
  Kind @(Type -> Type)@ proxy version of 'cloneUnboxed#'.
-}
pcloneUnboxedM :: (Unboxed e) => proxy e -> MutableByteArray# s -> Int# -> Int# ->
  State# s -> (# State# s, MutableByteArray# s #)
pcloneUnboxedM =  cloneUnboxedM# . fromProxy

{- |
  @since 0.2.1
  Kind @(Type -> Type)@ proxy version of 'thawUnboxed#'.
-}
pthawUnboxed :: (Unboxed e) => proxy e -> ByteArray# -> Int# ->
  State# s -> (# State# s, MutableByteArray# s #)
pthawUnboxed =  thawUnboxed# . fromProxy

{- |
  @since 0.2.1
  Kind @(Type -> Type)@ proxy version of 'pfreezeUnboxed'.
-}
pfreezeUnboxed :: (Unboxed e) => proxy e -> MutableByteArray# s -> Int# ->
  State# s -> (# State# s, ByteArray# #)
pfreezeUnboxed =  freezeUnboxed# . fromProxy

--------------------------------------------------------------------------------

{- (Type -> Type -> Type)-kind Unboxed proxies. -}

-- | Returns 'undefined' of suitable type.
fromProxy1 :: m (proxy e) -> e
fromProxy1 =  const undefined

{- |
  @since 0.2
  Kind @(Type -> Type -> Type)@ proxy version of 'newUnboxed'.
-}
pnewUnboxed1 :: (Unboxed e) => p (proxy e) -> Int# ->
  State# s -> (# State# s, MutableByteArray# s #)
pnewUnboxed1 =  newUnboxed . fromProxy1

{- |
  @since 0.2
  Kind @(Type -> Type -> Type)@ proxy version of 'copyUnboxed#'.
-}
pcopyUnboxed1 :: (Unboxed e) => p (proxy e) -> ByteArray# -> Int# ->
  MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
pcopyUnboxed1 =  copyUnboxed# . fromProxy1

{- |
  @since 0.2.1
  Kind @(Type -> Type -> Type)@ proxy version of 'copyUnboxedM#'.
-}
pcopyUnboxedM1 :: (Unboxed e) => p (proxy e) -> MutableByteArray# s -> Int# ->
  MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
pcopyUnboxedM1 =  copyUnboxedM# . fromProxy1

{- |
  @since 0.2.1
  Kind @(Type -> Type -> Type)@ proxy version of 'cloneUnboxed#'.
-}
pcloneUnboxed1 :: (Unboxed e) => p (proxy e) -> ByteArray# -> Int# -> Int# -> ByteArray#
pcloneUnboxed1 =  cloneUnboxed# . fromProxy1

{- |
  @since 0.2.1
  Kind @(Type -> Type -> Type)@ proxy version of 'cloneUnboxed#'.
-}
pcloneUnboxedM1 :: (Unboxed e) => p (proxy e) -> MutableByteArray# s -> Int# -> Int# ->
  State# s -> (# State# s, MutableByteArray# s #)
pcloneUnboxedM1 =  cloneUnboxedM# . fromProxy1

--------------------------------------------------------------------------------

{- Numeric instances. -}

instance Unboxed Int
  where
    {-# INLINE sizeof #-}
    sizeof _ n = max 0 n * SIZEOF_HSWORD

    {-# INLINE (!#) #-}
    bytes# !# i# = I# (indexIntArray# bytes# i#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readIntArray# mbytes# i# s1# of
      (# s2#, e# #) -> (# s2#, I# e# #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# (I# e#) = writeIntArray# mbytes# n# e#

    {-# INLINE newUnboxed #-}
    newUnboxed _ = newUnboxed' (0 :: Int)

instance Unboxed Int8
  where
    {-# INLINE sizeof #-}
    sizeof _ n = max 0 n

    {-# INLINE (!#) #-}
    bytes# !# i# = I8# (indexInt8Array# bytes# i#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readInt8Array# mbytes# i# s1# of
      (# s2#, e# #) -> (# s2#, I8# e# #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# (I8# e#) = writeInt8Array# mbytes# n# e#

    {-# INLINE newUnboxed #-}
    newUnboxed _ = newUnboxed' (0 :: Int8)

instance Unboxed Int16
  where
    {-# INLINE sizeof #-}
    sizeof _ n = max 0 n * 2

    {-# INLINE (!#) #-}
    bytes# !# i# = I16# (indexInt16Array# bytes# i#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readInt16Array# mbytes# i# s1# of
      (# s2#, e# #) -> (# s2#, I16# e# #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# (I16# e#) = writeInt16Array# mbytes# n# e#

    {-# INLINE newUnboxed #-}
    newUnboxed _ = newUnboxed' (0 :: Int16)

instance Unboxed Int32
  where
    {-# INLINE sizeof #-}
    sizeof _ n = max 0 n * 4

    {-# INLINE (!#) #-}
    bytes# !# i# = I32# (indexInt32Array# bytes# i#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readInt32Array# mbytes# i# s1# of
      (# s2#, e# #) -> (# s2#, I32# e# #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# (I32# e#) = writeInt32Array# mbytes# n# e#

    {-# INLINE newUnboxed #-}
    newUnboxed _ = newUnboxed' (0 :: Int32)

instance Unboxed Int64
  where
    {-# INLINE sizeof #-}
    sizeof _ n = max 0 n * 8

    {-# INLINE (!#) #-}
    bytes# !# i# = I64# (indexInt64Array# bytes# i#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readInt64Array# mbytes# i# s1# of
      (# s2#, e# #) -> (# s2#, I64# e# #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# (I64# e#) = writeInt64Array# mbytes# n# e#

    {-# INLINE newUnboxed #-}
    newUnboxed _ = newUnboxed' (0 :: Int64)

instance Unboxed Word
  where
    {-# INLINE sizeof #-}
    sizeof _ n = max 0 n * SIZEOF_HSWORD

    {-# INLINE (!#) #-}
    bytes# !# i# = W# (indexWordArray# bytes# i#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readWordArray# mbytes# i# s1# of
      (# s2#, e# #) -> (# s2#, W# e# #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# (W# e#) = writeWordArray# mbytes# n# e#

    {-# INLINE newUnboxed #-}
    newUnboxed _ = newUnboxed' (0 :: Word)

instance Unboxed Word8
  where
    {-# INLINE sizeof #-}
    sizeof _ n = max 0 n

    {-# INLINE (!#) #-}
    bytes# !# i# = W8# (indexWord8Array# bytes# i#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readWord8Array# mbytes# i# s1# of
      (# s2#, e# #) -> (# s2#, W8# e# #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# (W8#  e#) = writeWord8Array# mbytes# n# e#

    {-# INLINE newUnboxed #-}
    newUnboxed _ = newUnboxed' (0 :: Word8)

instance Unboxed Word16
  where
    {-# INLINE sizeof #-}
    sizeof _ n = max 0 n * 2

    {-# INLINE (!#) #-}
    bytes# !# i# = W16# (indexWord16Array# bytes# i#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readWord16Array# mbytes# i# s1# of
      (# s2#, e# #) -> (# s2#, W16# e# #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# (W16# e#) = writeWord16Array# mbytes# n# e#

    {-# INLINE newUnboxed #-}
    newUnboxed _ = newUnboxed' (0 :: Word16)

instance Unboxed Word32
  where
    {-# INLINE sizeof #-}
    sizeof _ n = max 0 n * 4

    {-# INLINE (!#) #-}
    bytes# !# i# = W32# (indexWord32Array# bytes# i#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readWord32Array# mbytes# i# s1# of
      (# s2#, e# #) -> (# s2#, W32# e# #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# (W32# e#) = writeWord32Array# mbytes# n# e#

    {-# INLINE newUnboxed #-}
    newUnboxed _ = newUnboxed' (0 :: Word32)

instance Unboxed Word64
  where
    {-# INLINE sizeof #-}
    sizeof _ n = max 0 n * 8

    {-# INLINE (!#) #-}
    bytes# !# i# = W64# (indexWord64Array# bytes# i#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readWord64Array# mbytes# i# s1# of
      (# s2#, e# #) -> (# s2#, W64# e# #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# (W64# e#) = writeWord64Array# mbytes# n# e#

    {-# INLINE newUnboxed #-}
    newUnboxed _ = newUnboxed' (0 :: Word64)

instance Unboxed Float
  where
    {-# INLINE sizeof #-}
    sizeof _ n = max 0 n * SIZEOF_HSFLOAT

    {-# INLINE (!#) #-}
    bytes# !# i# = F# (indexFloatArray# bytes# i#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readFloatArray# mbytes# i# s1# of
      (# s2#, f# #) -> (# s2#, F# f# #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# (F# e#) = writeFloatArray# mbytes# n# e#

    {-# INLINE newUnboxed #-}
    newUnboxed _ = newUnboxed' (0 :: Float)

instance Unboxed Double
  where
    {-# INLINE sizeof #-}
    sizeof _ n = max 0 n * SIZEOF_HSDOUBLE

    {-# INLINE (!#) #-}
    bytes# !# i# = D# (indexDoubleArray# bytes# i#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readDoubleArray# mbytes# i# s1# of
      (# s2#, d# #) -> (# s2#, D# d# #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# (D# e#) = writeDoubleArray# mbytes# n# e#

    {-# INLINE newUnboxed #-}
    newUnboxed _ = newUnboxed' (0 :: Double)

instance (Unboxed a, Integral a) => Unboxed (Ratio a)
  where
    sizeof e n = 2 * psizeof e n

    bytes# !# i# = bytes# !# i2# :% (bytes# !# (i2# +# 1#)) where i2# = 2# *# i#

    mbytes# !># i# = let i2# = 2# *# i# in \ s1# -> case (!>#) mbytes# i2# s1# of
      (# s2#, n #) -> case (!>#) mbytes# (i2# +# 1#) s2# of
        (# s3#, d #) -> (# s3#, n :% d #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# i# (n :% d) = let i2# = 2# *# i# in
      \ s1# -> case writeByteArray# mbytes# i2# n s1# of
        s2# -> writeByteArray# mbytes# (i2# +# 1#) d s2#

    {-# INLINE newUnboxed #-}
    newUnboxed e n# = pnewUnboxed e (2# *# n#)

instance (Unboxed a, Num a) => Unboxed (Complex a)
  where
    sizeof e n = 2 * psizeof e n

    bytes#  !#  i# = bytes# !# i2# :+ (bytes# !# (i2# +# 1#)) where i2# = 2# *# i#
    mbytes# !># i# = let i2# = 2# *# i# in \ s1# -> case (!>#) mbytes# i2# s1# of
      (# s2#, n #) -> case (!>#) mbytes# (i2# +# 1#) s2# of
        (# s3#, d #) -> (# s3#, n :+ d #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# i# (n :+ d) = let i2# = 2# *# i# in
      \ s1# -> case writeByteArray# mbytes# i2# n s1# of
        s2# -> writeByteArray# mbytes# (i2# +# 1#) d s2#

    {-# INLINE newUnboxed #-}
    newUnboxed e n# = pnewUnboxed e (2# *# n#)

--------------------------------------------------------------------------------

{- Pointer instances. -}

instance Unboxed (Ptr a)
  where
    {-# INLINE sizeof #-}
    sizeof _ n = max 0 n * SIZEOF_HSWORD

    {-# INLINE (!#) #-}
    bytes# !# i# = Ptr (indexAddrArray# bytes# i#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readAddrArray# mbytes# i# s1# of
      (# s2#, e# #) -> (# s2#, Ptr e# #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# (Ptr e) = writeAddrArray# mbytes# n# e

    {-# INLINE newUnboxed #-}
    newUnboxed _ = newUnboxed' nullPtr

instance Unboxed (FunPtr a)
  where
    {-# INLINE sizeof #-}
    sizeof _ n = max 0 n * SIZEOF_HSWORD

    {-# INLINE (!#) #-}
    bytes#  !#  i# = FunPtr (indexAddrArray# bytes# i#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readAddrArray# mbytes# i# s1# of
      (# s2#, e# #) -> (# s2#, FunPtr e# #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# (FunPtr e) = writeAddrArray# mbytes# n# e

    {-# INLINE newUnboxed #-}
    newUnboxed e = newUnboxed' (NULL `asTypeOf` e)

instance Unboxed (StablePtr a)
  where
    {-# INLINE sizeof #-}
    sizeof _ n = max 0 n * SIZEOF_HSWORD

    {-# INLINE (!#) #-}
    bytes# !# i# = StablePtr (indexStablePtrArray# bytes# i#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readStablePtrArray# mbytes# i# s1# of
      (# s2#, e# #) -> (# s2#, StablePtr e# #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# (StablePtr e) = writeStablePtrArray# mbytes# n# e

    {-# INLINE newUnboxed #-}
    newUnboxed e = newUnboxed' (NULL `asTypeOf` e)

--------------------------------------------------------------------------------

{- Foreign C instances. -}

#define deriving_instance_Unboxed(Type)\
instance Unboxed Type where\
{\
  sizeof e = sizeof (consSizeof Type e);\
  arr# !# i# = Type ( arr# !# i# );\
  marr# !># i# = \ s1# -> case (!>#) marr# i# s1# of {(# s2#, e #) -> (# s2#, Type e #)};\
  writeByteArray# marr# i# (Type e) = writeByteArray# marr# i# e;\
  fillByteArray#  marr# i# (Type e) = fillByteArray#  marr# i# e;\
  newUnboxed  (Type e) = newUnboxed  e;\
  newUnboxed' (Type e) = newUnboxed' e;\
}

deriving_instance_Unboxed(CChar)
deriving_instance_Unboxed(CSChar)
deriving_instance_Unboxed(CWchar)
deriving_instance_Unboxed(CShort)
deriving_instance_Unboxed(CUShort)

deriving_instance_Unboxed(CInt)
deriving_instance_Unboxed(CUInt)
deriving_instance_Unboxed(CLong)
deriving_instance_Unboxed(CULong)
deriving_instance_Unboxed(CLLong)
deriving_instance_Unboxed(CULLong)
deriving_instance_Unboxed(CIntPtr)
deriving_instance_Unboxed(CUIntPtr)
deriving_instance_Unboxed(CIntMax)
deriving_instance_Unboxed(CUIntMax)
deriving_instance_Unboxed(CPtrdiff)

deriving_instance_Unboxed(CTime)
deriving_instance_Unboxed(CClock)
deriving_instance_Unboxed(CUSeconds)
deriving_instance_Unboxed(CSUSeconds)

deriving_instance_Unboxed(CSize)

#if MIN_VERSION_base(4,10,0)
-- | @since base-4.10.0.0
deriving_instance_Unboxed(CBool)
#endif

deriving_instance_Unboxed(CFloat)
deriving_instance_Unboxed(CDouble)
deriving_instance_Unboxed(CSigAtomic)

#undef deriving_instance_Unboxed

--------------------------------------------------------------------------------

{- Other instances. -}

instance Unboxed Bool
  where
    {-# INLINE sizeof #-}
    sizeof _ c = d == 0 ? n $ n + 1 where (n, d) = max 0 c `divMod` 8

    {-# INLINE (!#) #-}
    bytes# !# i# = isTrue# ((indexWordArray# bytes# (bool_index i#) `and#` bool_bit i#) `neWord#` int2Word# 0#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readWordArray# mbytes# (bool_index i#) s1# of
      (# s2#, e# #) -> (# s2#, isTrue# ((e# `and#` bool_bit i#) `neWord#` int2Word# 0#) #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# e = \ s1# -> case readWordArray# mbytes# i# s1# of
        (# s2#, old_byte# #) -> writeWordArray# mbytes# i# (bitWrite old_byte#) s2#
      where
        bitWrite old_byte# = if e then old_byte# `or#` bool_bit n# else old_byte# `and#` bool_not_bit n#
        i# = bool_index n#

    {-# INLINE newUnboxed #-}
    newUnboxed _ = newUnboxed' False

    fillByteArray# mbytes# n# e =
      setByteArray# mbytes# 0# (bool_scale n#) (if e then 0xff# else 0#)

    copyUnboxed# e bytes# o1# mbytes# o2# c# = isTrue# (c# <# 1#) ? (\ s1# -> s1#) $
      \ s1# -> case writeByteArray# mbytes# o2# ((bytes# !# o1#) `asTypeOf` e) s1# of
        s2# -> copyUnboxed# e bytes# (o1# +# 1#) mbytes# (o2# +# 1#) (c# -# 1#) s2#

    copyUnboxedM# e src# o1# mbytes# o2# n# = \ s1# -> case (!>#) src# o1# s1# of
      (# s2#, x #) -> case writeByteArray# mbytes# o2# (x `asTypeOf` e) s2# of
        s3# -> copyUnboxedM# e src# (o1# +# 1#) mbytes# (o2# +# 1#) (n# -# 1#) s3#

    hashUnboxedWith e len# off# bytes#
        | isTrue#   (len# <# 1#)    = \ salt# -> salt#
        | isTrue#   (off# <# 0#)    = hashUnboxedWith e len# 0# bytes#
        | isTrue# (bit_off# ==# 0#) = go0 byte_cnt# byte_off#
        |            True           = goo byte_cnt# (byte_off# +# 1#) (indexWord8Array# bytes# byte_off#)
      where
        go0 0# _  salt# = salt#
        go0 1# o# salt# = hash# salt# (indexWord8Array# bytes# o# `and#` mask#)
        go0 n# o# salt# = go0 (n# -# 1#) (o# +# 1#) (salt# `hash#` indexWord8Array# bytes# o#)

        goo 0# _    _   salt# = salt#
        goo 1# _  temp# salt# = hash# salt# (shiftRL# temp# bit_off# `and#` mask#)
        goo n# o# temp# salt# = goo (n# -# 1#) (o# +# 1#) byte# (hash# salt# curr#)
          where
            curr# = shiftRL# temp# bit_off# `or#` shiftL# byte# (8# -# bit_off#)
            byte# = indexWord8Array# bytes# o#

        hash# = \ s# v# -> word2Int# (int2Word# (s# *# 16777619#) `xor#` v#)
        mask# = int2Word# 0xff# `shiftRL#` bit_rest#

        !(I# byte_off#, I# bit_off#) = I# off# `divMod` 8
        !(I# bit_len#) = I# len# `mod` 8

        bit_rest# = if isTrue# (bit_len# ==# 0#) then 0# else 8# -# bit_len#
        byte_cnt# = sizeof# e len#

instance Unboxed Char
  where
    {-# INLINE sizeof #-}
    sizeof _ n = max 0 n * 4

    {-# INLINE (!#) #-}
    bytes# !# i# = C# (indexWideCharArray# bytes# i#)

    {-# INLINE (!>#) #-}
    mbytes# !># i# = \ s1# -> case readWideCharArray# mbytes# i# s1# of
      (# s2#, c# #) -> (# s2#, C# c# #)

    {-# INLINE writeByteArray# #-}
    writeByteArray# mbytes# n# (C# e#) = writeWideCharArray# mbytes# n# e#

    {-# INLINE newUnboxed #-}
    newUnboxed e n# = \ s1# -> case newByteArray# (sizeof# e n#) s1# of
      (# s2#, mbytes# #) -> case fillByteArray# mbytes# n# '\0' s2# of
        s3# -> (# s3#, mbytes# #)

instance Unboxed E
  where
    {-# INLINE sizeof #-}
    sizeof _ _ = 0

    {-# INLINE (!#) #-}
    (!>#) = \ _ _ s# -> (# s#, E #)
    (!#)  = \ _ _ -> E

    newUnboxed  _ _ = newByteArray# 0#
    newUnboxed' _ _ = newByteArray# 0#

    writeByteArray# _ _ = \ _ s# -> s#
    fillByteArray#  _ _ = \ _ s# -> s#

instance (Unboxed e) => Unboxed (I1 e)
  where
    sizeof# = psizeof#
    sizeof  = psizeof

    bytes# !#  i# = E :& (bytes# !# i#)
    bytes# !># i# = \ s1# -> case (!>#) bytes# i# s1# of
      (# s2#, e #) -> (# s2#, E :& e #)

    writeByteArray# bytes# n# (E :& e) = writeByteArray# bytes# n# e
    fillByteArray#  bytes# n# (E :& e) = fillByteArray#  bytes# n# e

    newUnboxed' = \ (E :& i) -> newUnboxed i
    newUnboxed  = pnewUnboxed

instance (Enum e, Shape e, Bounded e, Unboxed e, Shape (e' :& e), Unboxed (e' :& e)) => Unboxed (e' :& e :& e)
  where
    sizeof# e n# = psizeof# e (rank# e *# n#)
    sizeof  e  n = psizeof  e (rank  e *   n)

    bytes# !# i# = go undefined
      where
        go t =
          let r# = rank# t; o# = i#*#r# +# i#
          in  ((bytes# !# o#) `asTypeOf` t) :& (bytes# !# (o# +# r#))

    bytes# !># i# = go undefined
      where
        go t = let r# = rank# t; o# = i#*#r# +# i# in
          \ s1# -> case (!>#) bytes# o# s1# of
            (# s2#, es #) -> case (!>#) bytes# (o# +# r#) s2# of
              (# s3#, e #) -> (# s3#, (es `asTypeOf` t) :& e #)

    writeByteArray# bytes# i# (es :& e) = let r# = rank# es; o# = i#*#r# +# i# in
      \ s1# -> case writeByteArray# bytes# o# es s1# of
        s2# -> writeByteArray# bytes# (o# +# r#) e s2#

    newUnboxed e n# = pnewUnboxed e (rank# e *# n#)

--------------------------------------------------------------------------------

{- Tuple instances. -}

instance Unboxed ()
  where
    {-# INLINE sizeof #-}
    sizeof _ _ = 0

    {-# INLINE (!#) #-}
    (!>#) = \ _ _ s# -> (# s#, () #)
    (!#)  = \ _ _ -> ()

    newUnboxed  _ _ = newByteArray# 0#
    newUnboxed' _ _ = newByteArray# 0#

    writeByteArray# _ _ = \ _ s# -> s#
    fillByteArray#  _ _ = \ _ s# -> s#

instance (Unboxed e) => Unboxed (T2 e)
  where
    sizeof  e2 n  = psizeof  e2 (2  *   n)
    sizeof# e2 n# = psizeof# e2 (2# *# n#)

    bytes# !#  n# = let o# = 2# *# n# in (bytes# !# o#, bytes# !# (o#+#1#))
    bytes# !># n# = let o# = 2# *# n# in \ s1# -> case (!>#) bytes# o# s1# of
      (# s2#, e1 #) -> case (!>#) bytes# (o# +# 1#) s2# of
        (# s3#, e2 #) -> (# s3#, (e1,e2) #)

    writeByteArray# mbytes# n# (e1,e2) = let o# = 2# *# n# in
      \ s1# -> case writeByteArray# mbytes# o# e1 s1# of
        s2# -> writeByteArray# mbytes# (o# +# 1#) e2 s2#

    newUnboxed e n# = pnewUnboxed e (2# *# n#)

instance (Unboxed e) => Unboxed (T3 e)
  where
    sizeof  e2 n  = psizeof  e2 (3  *   n)
    sizeof# e2 n# = psizeof# e2 (3# *# n#)

    bytes# !# n# =
      let o# = 3# *# n#
      in  (bytes# !# o#, bytes# !# (o#+#1#), bytes# !# (o#+#2#))

    bytes# !># n# = let o# = 3# *# n# in \ s1# -> case (!>#) bytes# o# s1# of
      (# s2#, e1 #) -> case (!>#) bytes# (o# +# 1#) s2# of
        (# s3#, e2 #) -> case (!>#) bytes# (o# +# 2#) s3# of
          (# s4#, e3 #) -> (# s4#, (e1,e2,e3) #)

    writeByteArray# mbytes# n# (e1,e2,e3) = let o# = 3# *# n# in
      \ s1# -> case writeByteArray# mbytes# o# e1 s1# of
        s2# -> case writeByteArray# mbytes# (o# +# 1#) e2 s2# of
          s3# -> writeByteArray# mbytes# (o# +# 2#) e3 s3#

    newUnboxed e n# = pnewUnboxed e (3# *# n#)

instance (Unboxed e) => Unboxed (T4 e)
  where
    sizeof  e2 n  = psizeof  e2 (4  *   n)
    sizeof# e2 n# = psizeof# e2 (4# *# n#)

    bytes# !# n# =
      let o# = 4# *# n#
      in  (bytes# !# o#, bytes# !# (o#+#1#), bytes# !# (o#+#2#), bytes# !# (o#+#3#))

    bytes# !># n# = let o# = 4# *# n# in \ s1# -> case (!>#) bytes# o# s1# of
      (# s2#, e1 #) -> case (!>#) bytes# (o# +# 1#) s2# of
        (# s3#, e2 #) -> case (!>#) bytes# (o# +# 2#) s3# of
          (# s4#, e3 #) -> case (!>#) bytes# (o# +# 3#) s4# of
            (# s5#, e4 #) -> (# s5#, (e1,e2,e3,e4) #)

    writeByteArray# mbytes# n# (e1,e2,e3,e4) = let o# = 4# *# n# in
      \ s1# -> case writeByteArray# mbytes# o# e1 s1# of
        s2# -> case writeByteArray# mbytes# (o# +# 1#) e2 s2# of
          s3# -> case writeByteArray# mbytes# (o# +# 2#) e3 s3# of
            s4# -> writeByteArray# mbytes# (o# +# 3#) e4 s4#

    newUnboxed e n# = pnewUnboxed e (4# *# n#)

instance (Unboxed e) => Unboxed (T5 e)
  where
    sizeof  e2 n  = psizeof  e2 (5  *   n)
    sizeof# e2 n# = psizeof# e2 (5# *# n#)

    bytes# !# n# =
      let o# = 5# *# n#
      in
        (
          bytes# !#       o#, bytes# !# (o#+#1#), bytes# !# (o#+#2#),
          bytes# !# (o#+#3#), bytes# !# (o#+#4#)
        )

    bytes# !># n# = let o# = 5# *# n# in \ s1# -> case (!>#) bytes# o# s1# of
      (# s2#, e1 #) -> case (!>#) bytes# (o# +# 1#) s2# of
        (# s3#, e2 #) -> case (!>#) bytes# (o# +# 2#) s3# of
          (# s4#, e3 #) -> case (!>#) bytes# (o# +# 3#) s4# of
            (# s5#, e4 #) -> case (!>#) bytes# (o# +# 4#) s5# of
              (# s6#, e5 #) -> (# s6#, (e1,e2,e3,e4,e5) #)

    writeByteArray# mbytes# n# (e1,e2,e3,e4,e5) = let o# = 5# *# n# in
      \ s1# -> case writeByteArray# mbytes# o# e1 s1# of
        s2# -> case writeByteArray# mbytes# (o# +# 1#) e2 s2# of
          s3# -> case writeByteArray# mbytes# (o# +# 2#) e3 s3# of
            s4# -> case writeByteArray# mbytes# (o# +# 3#) e4 s4# of
              s5# -> writeByteArray# mbytes# (o# +# 4#) e5 s5#

    newUnboxed e n# = pnewUnboxed e (5# *# n#)

instance (Unboxed e) => Unboxed (T6 e)
  where
    sizeof  e2 n  = psizeof  e2 (6  *   n)
    sizeof# e2 n# = psizeof# e2 (6# *# n#)

    bytes# !# n# =
      let o# = 6# *# n#
      in
        (
          bytes# !#       o#, bytes# !# (o#+#1#), bytes# !# (o#+#2#),
          bytes# !# (o#+#3#), bytes# !# (o#+#4#), bytes# !# (o#+#5#)
        )

    bytes# !># n# = let o# = 6# *# n# in \ s1# -> case (!>#) bytes# o# s1# of
      (# s2#, e1 #) -> case (!>#) bytes# (o# +# 1#) s2# of
        (# s3#, e2 #) -> case (!>#) bytes# (o# +# 2#) s3# of
          (# s4#, e3 #) -> case (!>#) bytes# (o# +# 3#) s4# of
            (# s5#, e4 #) -> case (!>#) bytes# (o# +# 4#) s5# of
              (# s6#, e5 #) -> case (!>#) bytes# (o# +# 5#) s6# of
                (# s7#, e6 #) -> (# s7#, (e1,e2,e3,e4,e5,e6) #)

    writeByteArray# mbytes# n# (e1,e2,e3,e4,e5,e6) = let o# = 6# *# n# in
      \ s1# -> case writeByteArray# mbytes# o# e1 s1# of
        s2# -> case writeByteArray# mbytes# (o# +# 1#) e2 s2# of
          s3# -> case writeByteArray# mbytes# (o# +# 2#) e3 s3# of
            s4# -> case writeByteArray# mbytes# (o# +# 3#) e4 s4# of
              s5# -> case writeByteArray# mbytes# (o# +# 4#) e5 s5# of
                s6# -> writeByteArray# mbytes# (o# +# 5#) e6 s6#

    newUnboxed e n# = pnewUnboxed e (6# *# n#)

instance (Unboxed e) => Unboxed (T7 e)
  where
    sizeof  e2 n  = psizeof  e2 (7  *   n)
    sizeof# e2 n# = psizeof# e2 (7# *# n#)

    bytes# !# n# =
      let o# = 7# *# n#
      in
        (
          bytes# !#       o#, bytes# !# (o#+#1#), bytes# !# (o#+#2#),
          bytes# !# (o#+#3#), bytes# !# (o#+#4#), bytes# !# (o#+#5#),
          bytes# !# (o#+#6#)
        )

    bytes# !># n# = let o# = 7# *# n# in \ s1# -> case (!>#) bytes# o# s1# of
      (# s2#, e1 #) -> case (!>#) bytes# (o# +# 1#) s2# of
        (# s3#, e2 #) -> case (!>#) bytes# (o# +# 2#) s3# of
          (# s4#, e3 #) -> case (!>#) bytes# (o# +# 3#) s4# of
            (# s5#, e4 #) -> case (!>#) bytes# (o# +# 4#) s5# of
              (# s6#, e5 #) -> case (!>#) bytes# (o# +# 5#) s6# of
                (# s7#, e6 #) -> case (!>#) bytes# (o# +# 6#) s7# of
                  (# s8#, e7 #) -> (# s8#, (e1,e2,e3,e4,e5,e6,e7) #)

    writeByteArray# mbytes# n# (e1,e2,e3,e4,e5,e6,e7) = let o# = 7# *# n# in
      \ s1# -> case writeByteArray# mbytes# o# e1 s1# of
        s2# -> case writeByteArray# mbytes# (o# +# 1#) e2 s2# of
          s3# -> case writeByteArray# mbytes# (o# +# 2#) e3 s3# of
            s4# -> case writeByteArray# mbytes# (o# +# 3#) e4 s4# of
              s5# -> case writeByteArray# mbytes# (o# +# 4#) e5 s5# of
                s6# -> case writeByteArray# mbytes# (o# +# 5#) e6 s6# of
                  s7# -> writeByteArray# mbytes# (o# +# 6#) e7 s7#

    newUnboxed e n# = pnewUnboxed e (7# *# n#)

instance (Unboxed e) => Unboxed (T8 e)
  where
    sizeof  e2 n  = psizeof  e2 (8  *   n)
    sizeof# e2 n# = psizeof# e2 (8# *# n#)

    bytes# !# n# =
      let o# = 8# *# n#
      in
        (
          bytes# !#       o#, bytes# !# (o#+#1#), bytes# !# (o#+#2#),
          bytes# !# (o#+#3#), bytes# !# (o#+#4#), bytes# !# (o#+#5#),
          bytes# !# (o#+#6#), bytes# !# (o#+#7#)
        )

    bytes# !># n# = let o# = 8# *# n# in \ s1# -> case (!>#) bytes# o# s1# of
      (# s2#, e1 #) -> case (!>#) bytes# (o# +# 1#) s2# of
        (# s3#, e2 #) -> case (!>#) bytes# (o# +# 2#) s3# of
          (# s4#, e3 #) -> case (!>#) bytes# (o# +# 3#) s4# of
            (# s5#, e4 #) -> case (!>#) bytes# (o# +# 4#) s5# of
              (# s6#, e5 #) -> case (!>#) bytes# (o# +# 5#) s6# of
                (# s7#, e6 #) -> case (!>#) bytes# (o# +# 6#) s7# of
                  (# s8#, e7 #) -> case (!>#) bytes# (o# +# 7#) s8# of
                    (# s9#, e8 #) -> (# s9#, (e1,e2,e3,e4,e5,e6,e7,e8) #)

    writeByteArray# mbytes# n# (e1,e2,e3,e4,e5,e6,e7,e8) = let o# = 8# *# n# in
      \ s1# -> case writeByteArray# mbytes# o# e1 s1# of
        s2# -> case writeByteArray# mbytes# (o# +# 1#) e2 s2# of
          s3# -> case writeByteArray# mbytes# (o# +# 2#) e3 s3# of
            s4# -> case writeByteArray# mbytes# (o# +# 3#) e4 s4# of
              s5# -> case writeByteArray# mbytes# (o# +# 4#) e5 s5# of
                s6# -> case writeByteArray# mbytes# (o# +# 5#) e6 s6# of
                  s7# -> case writeByteArray# mbytes# (o# +# 6#) e7 s7# of
                    s8# -> writeByteArray# mbytes# (o# +# 7#) e8 s8#

    newUnboxed e n# = pnewUnboxed e (8# *# n#)

instance (Unboxed e) => Unboxed (T9 e)
  where
    sizeof  e2 n  = psizeof  e2 (9  *   n)
    sizeof# e2 n# = psizeof# e2 (9# *# n#)

    bytes# !# n# =
      let o# = 9# *# n#
      in
        (
          bytes# !#       o#, bytes# !# (o#+#1#), bytes# !# (o#+#2#),
          bytes# !# (o#+#3#), bytes# !# (o#+#4#), bytes# !# (o#+#5#),
          bytes# !# (o#+#6#), bytes# !# (o#+#7#), bytes# !# (o#+#8#)
        )

    bytes# !># n# = let o# = 9# *# n# in \ s1# -> case (!>#) bytes# o# s1# of
      (# s2#, e1 #) -> case (!>#) bytes# (o# +# 1#) s2# of
        (# s3#, e2 #) -> case (!>#) bytes# (o# +# 2#) s3# of
          (# s4#, e3 #) -> case (!>#) bytes# (o# +# 3#) s4# of
            (# s5#, e4 #) -> case (!>#) bytes# (o# +# 4#) s5# of
              (# s6#, e5 #) -> case (!>#) bytes# (o# +# 5#) s6# of
                (# s7#, e6 #) -> case (!>#) bytes# (o# +# 6#) s7# of
                  (# s8#, e7 #) -> case (!>#) bytes# (o# +# 7#) s8# of
                    (# s9#, e8 #) -> case (!>#) bytes# (o# +# 8#) s9# of
                      (# s10#, e9 #) -> (# s10#, (e1,e2,e3,e4,e5,e6,e7,e8,e9) #)

    writeByteArray# mbytes# n# (e1,e2,e3,e4,e5,e6,e7,e8,e9) = let o# = 9# *# n# in
      \ s1# -> case writeByteArray# mbytes# o# e1 s1# of
        s2# -> case writeByteArray# mbytes# (o# +# 1#) e2 s2# of
          s3# -> case writeByteArray# mbytes# (o# +# 2#) e3 s3# of
            s4# -> case writeByteArray# mbytes# (o# +# 3#) e4 s4# of
              s5# -> case writeByteArray# mbytes# (o# +# 4#) e5 s5# of
                s6# -> case writeByteArray# mbytes# (o# +# 5#) e6 s6# of
                  s7# -> case writeByteArray# mbytes# (o# +# 6#) e7 s7# of
                    s8# -> case writeByteArray# mbytes# (o# +# 7#) e8 s8# of
                      s9# -> writeByteArray# mbytes# (o# +# 8#) e9 s9#

    newUnboxed e n# = pnewUnboxed e (9# *# n#)

instance (Unboxed e) => Unboxed (T10 e)
  where
    sizeof  e2 n  = psizeof  e2 (10  *   n)
    sizeof# e2 n# = psizeof# e2 (10# *# n#)

    bytes# !# n# =
      let o# = 10# *# n#
      in
        (
          bytes# !#       o#, bytes# !# (o#+#1#), bytes# !# (o#+#2#),
          bytes# !# (o#+#3#), bytes# !# (o#+#4#), bytes# !# (o#+#5#),
          bytes# !# (o#+#6#), bytes# !# (o#+#7#), bytes# !# (o#+#8#),
          bytes# !# (o#+#9#)
        )

    bytes# !># n# = let o# = 10# *# n# in \ s1# -> case (!>#) bytes# o# s1# of
      (# s2#, e1 #) -> case (!>#) bytes# (o# +# 1#) s2# of
        (# s3#, e2 #) -> case (!>#) bytes# (o# +# 2#) s3# of
          (# s4#, e3 #) -> case (!>#) bytes# (o# +# 3#) s4# of
            (# s5#, e4 #) -> case (!>#) bytes# (o# +# 4#) s5# of
              (# s6#, e5 #) -> case (!>#) bytes# (o# +# 5#) s6# of
                (# s7#, e6 #) -> case (!>#) bytes# (o# +# 6#) s7# of
                  (# s8#, e7 #) -> case (!>#) bytes# (o# +# 7#) s8# of
                    (# s9#, e8 #) -> case (!>#) bytes# (o# +# 8#) s9# of
                      (# s10#, e9 #) -> case (!>#) bytes# (o# +# 9#) s10# of
                        (# s11#, e10 #) -> (# s11#, (e1,e2,e3,e4,e5,e6,e7,e8,e9,e10) #)

    writeByteArray# mbytes# n# (e1,e2,e3,e4,e5,e6,e7,e8,e9,e10) = let o# = 10# *# n# in
      \ s1# -> case writeByteArray# mbytes# o# e1 s1# of
        s2# -> case writeByteArray# mbytes# (o# +# 1#) e2 s2# of
          s3# -> case writeByteArray# mbytes# (o# +# 2#) e3 s3# of
            s4# -> case writeByteArray# mbytes# (o# +# 3#) e4 s4# of
              s5# -> case writeByteArray# mbytes# (o# +# 4#) e5 s5# of
                s6# -> case writeByteArray# mbytes# (o# +# 5#) e6 s6# of
                  s7# -> case writeByteArray# mbytes# (o# +# 6#) e7 s7# of
                    s8# -> case writeByteArray# mbytes# (o# +# 7#) e8 s8# of
                      s9# -> case writeByteArray# mbytes# (o# +# 8#) e9 s9# of
                        s10# -> writeByteArray# mbytes# (o# +# 9#) e10 s10#

    newUnboxed e n# = pnewUnboxed e (10# *# n#)

instance (Unboxed e) => Unboxed (T11 e)
  where
    sizeof  e2 n  = psizeof  e2 (11  *   n)
    sizeof# e2 n# = psizeof# e2 (11# *# n#)

    bytes# !# n# =
      let o# = 11# *# n#
      in
        (
          bytes# !#       o#, bytes# !# (o#+#1#), bytes# !# (o#+#2#),
          bytes# !# (o#+#3#), bytes# !# (o#+#4#), bytes# !# (o#+#5#),
          bytes# !# (o#+#6#), bytes# !# (o#+#7#), bytes# !# (o#+#8#),
          bytes# !# (o#+#9#), bytes# !# (o#+#10#)
        )

    bytes# !># n# = let o# = 11# *# n# in \ s1# -> case (!>#) bytes# o# s1# of
      (# s2#, e1 #) -> case (!>#) bytes# (o# +# 1#) s2# of
        (# s3#, e2 #) -> case (!>#) bytes# (o# +# 2#) s3# of
          (# s4#, e3 #) -> case (!>#) bytes# (o# +# 3#) s4# of
            (# s5#, e4 #) -> case (!>#) bytes# (o# +# 4#) s5# of
              (# s6#, e5 #) -> case (!>#) bytes# (o# +# 5#) s6# of
                (# s7#, e6 #) -> case (!>#) bytes# (o# +# 6#) s7# of
                  (# s8#, e7 #) -> case (!>#) bytes# (o# +# 7#) s8# of
                    (# s9#, e8 #) -> case (!>#) bytes# (o# +# 8#) s9# of
                      (# s10#, e9 #) -> case (!>#) bytes# (o# +# 9#) s10# of
                        (# s11#, e10 #) -> case (!>#) bytes# (o# +# 10#) s11# of
                          (# s12#, e11 #) -> (# s12#, (e1,e2,e3,e4,e5,e6,e7,e8,e9,e10,e11) #)

    writeByteArray# mbytes# n# (e1,e2,e3,e4,e5,e6,e7,e8,e9,e10,e11) = let o# = 11# *# n# in
      \ s1# -> case writeByteArray# mbytes# o# e1 s1# of
        s2# -> case writeByteArray# mbytes# (o# +# 1#) e2 s2# of
          s3# -> case writeByteArray# mbytes# (o# +# 2#) e3 s3# of
            s4# -> case writeByteArray# mbytes# (o# +# 3#) e4 s4# of
              s5# -> case writeByteArray# mbytes# (o# +# 4#) e5 s5# of
                s6# -> case writeByteArray# mbytes# (o# +# 5#) e6 s6# of
                  s7# -> case writeByteArray# mbytes# (o# +# 6#) e7 s7# of
                    s8# -> case writeByteArray# mbytes# (o# +# 7#) e8 s8# of
                      s9# -> case writeByteArray# mbytes# (o# +# 8#) e9 s9# of
                        s10# -> case writeByteArray# mbytes# (o# +# 9#) e10 s10# of
                          s11# -> writeByteArray# mbytes# (o# +# 10#) e11 s11#

    newUnboxed e n# = pnewUnboxed e (11# *# n#)

instance (Unboxed e) => Unboxed (T12 e)
  where
    sizeof  e2 n  = psizeof  e2 (12  *   n)
    sizeof# e2 n# = psizeof# e2 (12# *# n#)

    bytes# !# n# =
      let o# = 12# *# n#
      in
        (
          bytes# !#       o#, bytes# !#  (o#+#1#), bytes# !#  (o#+#2#),
          bytes# !# (o#+#3#), bytes# !#  (o#+#4#), bytes# !#  (o#+#5#),
          bytes# !# (o#+#6#), bytes# !#  (o#+#7#), bytes# !#  (o#+#8#),
          bytes# !# (o#+#9#), bytes# !# (o#+#10#), bytes# !# (o#+#11#)
        )

    bytes# !># n# = let o# = 12# *# n# in \ s1# -> case (!>#) bytes# o# s1# of
      (# s2#, e1 #) -> case (!>#) bytes# (o# +# 1#) s2# of
        (# s3#, e2 #) -> case (!>#) bytes# (o# +# 2#) s3# of
          (# s4#, e3 #) -> case (!>#) bytes# (o# +# 3#) s4# of
            (# s5#, e4 #) -> case (!>#) bytes# (o# +# 4#) s5# of
              (# s6#, e5 #) -> case (!>#) bytes# (o# +# 5#) s6# of
                (# s7#, e6 #) -> case (!>#) bytes# (o# +# 6#) s7# of
                  (# s8#, e7 #) -> case (!>#) bytes# (o# +# 7#) s8# of
                    (# s9#, e8 #) -> case (!>#) bytes# (o# +# 8#) s9# of
                      (# s10#, e9 #) -> case (!>#) bytes# (o# +# 9#) s10# of
                        (# s11#, e10 #) -> case (!>#) bytes# (o# +# 10#) s11# of
                          (# s12#, e11 #) -> case (!>#) bytes# (o# +# 11#) s12# of
                            (# s13#, e12 #) -> (# s13#, (e1,e2,e3,e4,e5,e6,e7,e8,e9,e10,e11,e12) #)

    writeByteArray# mbytes# n# (e1,e2,e3,e4,e5,e6,e7,e8,e9,e10,e11,e12) = let o# = 12# *# n# in
      \ s1# -> case writeByteArray# mbytes# o# e1 s1# of
        s2# -> case writeByteArray# mbytes# (o# +# 1#) e2 s2# of
          s3# -> case writeByteArray# mbytes# (o# +# 2#) e3 s3# of
            s4# -> case writeByteArray# mbytes# (o# +# 3#) e4 s4# of
              s5# -> case writeByteArray# mbytes# (o# +# 4#) e5 s5# of
                s6# -> case writeByteArray# mbytes# (o# +# 5#) e6 s6# of
                  s7# -> case writeByteArray# mbytes# (o# +# 6#) e7 s7# of
                    s8# -> case writeByteArray# mbytes# (o# +# 7#) e8 s8# of
                      s9# -> case writeByteArray# mbytes# (o# +# 8#) e9 s9# of
                        s10# -> case writeByteArray# mbytes# (o# +# 9#) e10 s10# of
                          s11# -> case writeByteArray# mbytes# (o# +# 10#) e11 s11# of
                            s12# -> writeByteArray# mbytes# (o# +# 11#) e12 s12#

    newUnboxed e n# = pnewUnboxed e (12# *# n#)

instance (Unboxed e) => Unboxed (T13 e)
  where
    sizeof  e2 n  = psizeof  e2 (13  *   n)
    sizeof# e2 n# = psizeof# e2 (13# *# n#)

    bytes# !# n# =
      let o# = 13# *# n#
      in
        (
          bytes# !#        o#, bytes# !#  (o#+#1#), bytes# !#  (o#+#2#),
          bytes# !#  (o#+#3#), bytes# !#  (o#+#4#), bytes# !#  (o#+#5#),
          bytes# !#  (o#+#6#), bytes# !#  (o#+#7#), bytes# !#  (o#+#8#),
          bytes# !#  (o#+#9#), bytes# !# (o#+#10#), bytes# !# (o#+#11#),
          bytes# !# (o#+#12#)
        )

    bytes# !># n# = let o# = 13# *# n# in \ s1# -> case (!>#) bytes# o# s1# of
      (# s2#, e1 #) -> case (!>#) bytes# (o# +# 1#) s2# of
        (# s3#, e2 #) -> case (!>#) bytes# (o# +# 2#) s3# of
          (# s4#, e3 #) -> case (!>#) bytes# (o# +# 3#) s4# of
            (# s5#, e4 #) -> case (!>#) bytes# (o# +# 4#) s5# of
              (# s6#, e5 #) -> case (!>#) bytes# (o# +# 5#) s6# of
                (# s7#, e6 #) -> case (!>#) bytes# (o# +# 6#) s7# of
                  (# s8#, e7 #) -> case (!>#) bytes# (o# +# 7#) s8# of
                    (# s9#, e8 #) -> case (!>#) bytes# (o# +# 8#) s9# of
                      (# s10#, e9 #) -> case (!>#) bytes# (o# +# 9#) s10# of
                        (# s11#, e10 #) -> case (!>#) bytes# (o# +# 10#) s11# of
                          (# s12#, e11 #) -> case (!>#) bytes# (o# +# 11#) s12# of
                            (# s13#, e12 #) -> case (!>#) bytes# (o# +# 12#) s13# of
                              (# s14#, e13 #) -> (# s14#, (e1,e2,e3,e4,e5,e6,e7,e8,e9,e10,e11,e12,e13) #)

    writeByteArray# mbytes# n# (e1,e2,e3,e4,e5,e6,e7,e8,e9,e10,e11,e12,e13) = let o# = 13# *# n# in
      \ s1# -> case writeByteArray# mbytes# o# e1 s1# of
        s2# -> case writeByteArray# mbytes# (o# +# 1#) e2 s2# of
          s3# -> case writeByteArray# mbytes# (o# +# 2#) e3 s3# of
            s4# -> case writeByteArray# mbytes# (o# +# 3#) e4 s4# of
              s5# -> case writeByteArray# mbytes# (o# +# 4#) e5 s5# of
                s6# -> case writeByteArray# mbytes# (o# +# 5#) e6 s6# of
                  s7# -> case writeByteArray# mbytes# (o# +# 6#) e7 s7# of
                    s8# -> case writeByteArray# mbytes# (o# +# 7#) e8 s8# of
                      s9# -> case writeByteArray# mbytes# (o# +# 8#) e9 s9# of
                        s10# -> case writeByteArray# mbytes# (o# +# 9#) e10 s10# of
                          s11# -> case writeByteArray# mbytes# (o# +# 10#) e11 s11# of
                            s12# -> case writeByteArray# mbytes# (o# +# 11#) e12 s12# of
                              s13# -> writeByteArray# mbytes# (o# +# 12#) e13 s13#

    newUnboxed e n# = pnewUnboxed e (13# *# n#)

instance (Unboxed e) => Unboxed (T14 e)
  where
    sizeof  e2 n  = psizeof  e2 (14  *   n)
    sizeof# e2 n# = psizeof# e2 (14# *# n#)

    bytes# !# n# =
      let o# = 14# *# n#
      in
        (
          bytes# !#        o#, bytes# !#  (o#+#1#), bytes# !#  (o#+#2#),
          bytes# !#  (o#+#3#), bytes# !#  (o#+#4#), bytes# !#  (o#+#5#),
          bytes# !#  (o#+#6#), bytes# !#  (o#+#7#), bytes# !#  (o#+#8#),
          bytes# !#  (o#+#9#), bytes# !# (o#+#10#), bytes# !# (o#+#11#),
          bytes# !# (o#+#12#), bytes# !# (o#+#13#)
        )

    bytes# !># n# = let o# = 14# *# n# in \ s1# -> case (!>#) bytes# o# s1# of
      (# s2#, e1 #) -> case (!>#) bytes# (o# +# 1#) s2# of
        (# s3#, e2 #) -> case (!>#) bytes# (o# +# 2#) s3# of
          (# s4#, e3 #) -> case (!>#) bytes# (o# +# 3#) s4# of
            (# s5#, e4 #) -> case (!>#) bytes# (o# +# 4#) s5# of
              (# s6#, e5 #) -> case (!>#) bytes# (o# +# 5#) s6# of
                (# s7#, e6 #) -> case (!>#) bytes# (o# +# 6#) s7# of
                  (# s8#, e7 #) -> case (!>#) bytes# (o# +# 7#) s8# of
                    (# s9#, e8 #) -> case (!>#) bytes# (o# +# 8#) s9# of
                      (# s10#, e9 #) -> case (!>#) bytes# (o# +# 9#) s10# of
                        (# s11#, e10 #) -> case (!>#) bytes# (o# +# 10#) s11# of
                          (# s12#, e11 #) -> case (!>#) bytes# (o# +# 11#) s12# of
                            (# s13#, e12 #) -> case (!>#) bytes# (o# +# 12#) s13# of
                              (# s14#, e13 #) -> case (!>#) bytes# (o# +# 13#) s14# of
                                (# s15#, e14 #) -> (# s15#, (e1,e2,e3,e4,e5,e6,e7,e8,e9,e10,e11,e12,e13,e14) #)

    writeByteArray# mbytes# n# (e1,e2,e3,e4,e5,e6,e7,e8,e9,e10,e11,e12,e13,e14) =
      \ s1# -> let o# = 14# *# n# in case writeByteArray# mbytes# o# e1 s1# of
        s2# -> case writeByteArray# mbytes# (o# +# 1#) e2 s2# of
          s3# -> case writeByteArray# mbytes# (o# +# 2#) e3 s3# of
            s4# -> case writeByteArray# mbytes# (o# +# 3#) e4 s4# of
              s5# -> case writeByteArray# mbytes# (o# +# 4#) e5 s5# of
                s6# -> case writeByteArray# mbytes# (o# +# 5#) e6 s6# of
                  s7# -> case writeByteArray# mbytes# (o# +# 6#) e7 s7# of
                    s8# -> case writeByteArray# mbytes# (o# +# 7#) e8 s8# of
                      s9# -> case writeByteArray# mbytes# (o# +# 8#) e9 s9# of
                        s10# -> case writeByteArray# mbytes# (o# +# 9#) e10 s10# of
                          s11# -> case writeByteArray# mbytes# (o# +# 10#) e11 s11# of
                            s12# -> case writeByteArray# mbytes# (o# +# 11#) e12 s12# of
                              s13# -> case writeByteArray# mbytes# (o# +# 12#) e13 s13# of
                                s14# -> writeByteArray# mbytes# (o# +# 13#) e14 s14#

    newUnboxed e n# = pnewUnboxed e (14# *# n#)

instance (Unboxed e) => Unboxed (T15 e)
  where
    sizeof  e2 n  = psizeof  e2 (15  *   n)
    sizeof# e2 n# = psizeof# e2 (15# *# n#)

    bytes# !# n# =
      let o# = 15# *# n#
      in
        (
          bytes# !#        o#, bytes# !#  (o#+#1#), bytes# !#  (o#+#2#),
          bytes# !#  (o#+#3#), bytes# !#  (o#+#4#), bytes# !#  (o#+#5#),
          bytes# !#  (o#+#6#), bytes# !#  (o#+#7#), bytes# !#  (o#+#8#),
          bytes# !#  (o#+#9#), bytes# !# (o#+#10#), bytes# !# (o#+#11#),
          bytes# !# (o#+#12#), bytes# !# (o#+#13#), bytes# !# (o#+#14#)
        )

    bytes# !># n# = let o# = 15# *# n# in \ s1# -> case (!>#) bytes# o# s1# of
      (# s2#, e1 #) -> case (!>#) bytes# (o# +# 1#) s2# of
        (# s3#, e2 #) -> case (!>#) bytes# (o# +# 2#) s3# of
          (# s4#, e3 #) -> case (!>#) bytes# (o# +# 3#) s4# of
            (# s5#, e4 #) -> case (!>#) bytes# (o# +# 4#) s5# of
              (# s6#, e5 #) -> case (!>#) bytes# (o# +# 5#) s6# of
                (# s7#, e6 #) -> case (!>#) bytes# (o# +# 6#) s7# of
                  (# s8#, e7 #) -> case (!>#) bytes# (o# +# 7#) s8# of
                    (# s9#, e8 #) -> case (!>#) bytes# (o# +# 8#) s9# of
                      (# s10#, e9 #) -> case (!>#) bytes# (o# +# 9#) s10# of
                        (# s11#, e10 #) -> case (!>#) bytes# (o# +# 10#) s11# of
                          (# s12#, e11 #) -> case (!>#) bytes# (o# +# 11#) s12# of
                            (# s13#, e12 #) -> case (!>#) bytes# (o# +# 12#) s13# of
                              (# s14#, e13 #) -> case (!>#) bytes# (o# +# 13#) s14# of
                                (# s15#, e14 #) -> case (!>#) bytes# (o# +# 14#) s15# of
                                  (# s16#, e15 #) -> (# s16#, (e1,e2,e3,e4,e5,e6,e7,e8,e9,e10,e11,e12,e13,e14,e15) #)

    writeByteArray# mbytes# n# (e1,e2,e3,e4,e5,e6,e7,e8,e9,e10,e11,e12,e13,e14,e15) =
      \ s1# -> let o# = 15# *# n# in case writeByteArray# mbytes# o# e1 s1# of
        s2# -> case writeByteArray# mbytes# (o# +# 1#) e2 s2# of
          s3# -> case writeByteArray# mbytes# (o# +# 2#) e3 s3# of
            s4# -> case writeByteArray# mbytes# (o# +# 3#) e4 s4# of
              s5# -> case writeByteArray# mbytes# (o# +# 4#) e5 s5# of
                s6# -> case writeByteArray# mbytes# (o# +# 5#) e6 s6# of
                  s7# -> case writeByteArray# mbytes# (o# +# 6#) e7 s7# of
                    s8# -> case writeByteArray# mbytes# (o# +# 7#) e8 s8# of
                      s9# -> case writeByteArray# mbytes# (o# +# 8#) e9 s9# of
                        s10# -> case writeByteArray# mbytes# (o# +# 9#) e10 s10# of
                          s11# -> case writeByteArray# mbytes# (o# +# 10#) e11 s11# of
                            s12# -> case writeByteArray# mbytes# (o# +# 11#) e12 s12# of
                              s13# -> case writeByteArray# mbytes# (o# +# 12#) e13 s13# of
                                s14# -> case writeByteArray# mbytes# (o# +# 13#) e14 s14# of
                                  s15# -> writeByteArray# mbytes# (o# +# 14#) e15 s15#

    newUnboxed e n# = pnewUnboxed e (15# *# n#)

--------------------------------------------------------------------------------

-- | 'ByteArray#' wrapper.
data Wrap = Wrap {unwrap :: ByteArray#}

{- |
  @since 0.2.1
  Wrapped empty 'ByteArray#'.
-}
lzero# :: Wrap
lzero# =  runST $ ST $ \ s1# -> case newByteArray# 0# s1# of
  (# s2#, marr# #) -> case unsafeFreezeByteArray# marr# s2# of
    (# s3#, arr# #) -> (# s3#, Wrap arr# #)

{- |
  @since 0.2.1
  'ByteArray#' singleton.
-}
single# :: (Unboxed e) => e -> ByteArray#
single# e = unwrap $ runST $ ST $ \ s1# -> case newUnboxed' e 1# s1# of
  (# s2#, marr# #) -> case unsafeFreezeByteArray# marr# s2# of
    (# s3#, arr# #) -> (# s3#, Wrap arr# #)

{- |
  @since 0.2.1
  Create immutable 'Unboxed' array from given list.
-}
fromList# :: (Unboxed e) => [e] -> ByteArray#
fromList# es = let !(I# n#) = length es in fromListN# n# es

{- |
  @since 0.2.1
  Create immutable 'Unboxed' array from 'Foldable' stream.
-}
fromFoldable# :: (Foldable f, Unboxed e) => f e -> (# Int, ByteArray# #)
fromFoldable# es = unpack' $ runST $ ST $ \ s1# -> case fromFoldableM# es s1# of
    (# s2#, n, marr# #) -> case unsafeFreezeByteArray# marr# s2# of
      (# s3#, arr# #) -> (# s3#, (n, Wrap arr#) #)
  where
    unpack' (i, Wrap arr#) = (# i, arr# #)

{- |
  @since 0.2.1
  Create immutable 'Unboxed' array from known size list.
-}
fromListN# :: (Unboxed e) => Int# -> [e] -> ByteArray#
fromListN# n# es = unwrap $ runST $ ST $ \ s1# -> case newLinearN# n# es s1# of
  (# s2#, marr# #) -> case unsafeFreezeByteArray# marr# s2# of
    (# s3#, arr# #) -> (# s3#, Wrap arr# #)

{- |
  @since 0.2.1
  Create mutable 'Unboxed' array from given list.
-}
newLinear# :: (Unboxed e) => [e] -> State# s ->
  (# State# s, MutableByteArray# s #)
newLinear# es = let !(I# n#) = length es in newLinearN# n# es

{- |
  @since 0.2.1
  Create mutable 'Unboxed' array from known size list.
-}
newLinearN# :: (Unboxed e) => Int# -> [e] -> State# s ->
  (# State# s, MutableByteArray# s #)
newLinearN# c# es = \ s1# -> case pnewUnboxed es n# s1# of
    (# s2#, marr# #) ->
      let
        go y r = \ i# s4# -> case writeByteArray# marr# i# y s4# of
          s5# -> if isTrue# (i# ==# n# -# 1#) then s5# else r (i# +# 1#) s5#
      in case if n == 0 then s2# else foldr go (\ _ s# -> s#) es 0# s2# of
          s3# -> (# s3#, marr# #)
  where
    !n@(I# n#) = max 0 (I# c#)

{- |
  @since 0.2.1
  Create mutable 'Unboxed' array from 'Foldable' stream.
-}
fromFoldableM# :: (Foldable f, Unboxed e) => f e -> State# s ->
  (# State# s, Int, MutableByteArray# s #)
fromFoldableM# es = \ s1# -> case pnewUnboxed es n# s1# of
    (# s2#, marr# #) ->
      let
        go y r = \ i# s4# -> case writeByteArray# marr# i# y s4# of
          s5# -> if isTrue# (i# ==# n# -# 1#) then s5# else r (i# +# 1#) s5#
      in case if n == 0 then s2# else foldr go (\ _ s# -> s#) es 0# s2# of
          s3# -> (# s3#, n, marr# #)
  where
    !n@(I# n#) = length es

{- |
  @since 0.2.1
  Concatenation of two 'Unboxed' arrays.
-}
concat# :: (Unboxed e) => e ->
  ByteArray# -> Int# -> Int# ->
  ByteArray# -> Int# -> Int# -> State# s ->
  (# State# s, Int#, MutableByteArray# s #)
concat# e arr1# n1# o1# arr2# n2# o2# = \ s1# -> case newUnboxed e n# s1# of
    (# s2#, marr# #) -> case copyUnboxed# e arr1# o1# marr# 0# n1# s2# of
      s3# -> case copyUnboxed# e arr2# o2# marr# n1# n2# s3# of
        s4# -> (# s4#, n#, marr# #)
  where
    n# = n1# +# n2#

-- | Proxy concatenation of two byte arrays representing 'Unboxed' structures.
pconcat :: (Unboxed e) => proxy e ->
  ByteArray# -> Int# -> Int# -> ByteArray# -> Int# -> Int# ->
  State# s -> (# State# s, Int#, MutableByteArray# s #)
pconcat = concat# . fromProxy

--------------------------------------------------------------------------------

rank# :: (Shape i) => i -> Int#
rank# i = case rank i of I# r# -> r#

{-# INLINE bool_scale #-}
bool_scale :: Int# -> Int#
bool_scale n# = (n# +# 7#) `uncheckedIShiftRA#` 3#

{-# INLINE bool_bit #-}
bool_bit :: Int# -> Word#
bool_bit n# = case (SIZEOF_HSWORD * 8 - 1) of
  W# mask# -> int2Word# 1# `uncheckedShiftL#` word2Int# (int2Word# n# `and#` mask#)

{-# INLINE bool_not_bit #-}
bool_not_bit :: Int# -> Word#
bool_not_bit n# = case maxBound of W# mb# -> bool_bit n# `xor#` mb#

{-# INLINE bool_index #-}
bool_index :: Int# -> Int#
#if   SIZEOF_HSWORD == 4
bool_index =  (`uncheckedIShiftRA#` 5#)
#elif SIZEOF_HSWORD == 8
bool_index =  (`uncheckedIShiftRA#` 6#)
#endif

consSizeof :: (a -> b) -> b -> a
consSizeof =  \ _ _ -> undefined


module Main where
import Numeric.LinearAlgebra
import System.Random
import qualified Data.ByteString.Lazy as B
import Data.List
import Data.Time

import Tools
import Durstenfeld
import ForMNIST
import Gosadenban

main :: IO ()
main = do
    main3


{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ViewPatterns          #-}

-- | TODO
module SatOpt.Render ( Conf (..)
                     , runDisp
                     , KMState --(..)
                     , RGBTrips
                     ) where

import           Control.Concurrent.MVar
import           Control.Monad                 (when)
import           Data.Maybe                    (isJust)
import           Data.Packed.Vector            (buildVector)
import           Foreign                       (withArray)
import           Graphics.UI.GLUT
import           Numeric.LinearAlgebra.HMatrix hiding (reshape)
import           System.Exit                   (exitSuccess)

type Mℝ = Numeric.LinearAlgebra.HMatrix.Matrix ℝ

type RGBTrips = (Mℝ, Mℝ, Mℝ)

type KMState = String

data Conf a = Conf { keyBinds :: KMState -> (Conf a) -> IO (Conf a)
                   , state    :: a
                   , evolve   :: a -> a
                   , render   :: a -> RGBTrips
                   , canvas   :: (Int, Int)
                   }

imageSize :: Conf a -> TextureSize2D
imageSize (canvas -> (x, y)) = TextureSize2D (fromIntegral x) (fromIntegral y)

(//) :: (Integral a, Fractional b) => a -> a -> b
a // b = fromIntegral a / fromIntegral b

toColor :: Double -> Double -> Double -> Color4 GLubyte
toColor r g b = Color4 (tc r) (tc g) (tc b) 255
  where
    tc = round . (*250)

mapVecs3 :: (Container Vector a, Indexable (Vector a) a, Element b)
            => (a -> a -> a -> b)
            -> Vector a
            -> Vector a
            -> Vector a
            -> Vector b
mapVecs3 f x y z = buildVector (size x) (\i -> f (x ! i) (y ! i) (z ! i))

instance Element GLubyte
instance Element (Color4 GLubyte)

flattenImage :: RGBTrips -> Vector (Color4 GLubyte)
flattenImage (flatten -> r, flatten -> g, flatten -> b)
  = mapVecs3 toColor r g b

withImage :: Conf a -> (PixelData (Color4 GLubyte) -> IO ()) -> IO ()
withImage c act = withArray arr $ act . PixelData RGBA UnsignedByte
  where
    arr = toList $ flattenImage $ render c (state c)

myInit :: Conf a -> IO (Maybe TextureObject)
myInit c = do
   clearColor $= Color4 0 0 0 0
   shadeModel $= Flat
   depthFunc $= Just Less
   rowAlignment Unpack $= 1

   exts <- get glExtensions
   mbTexName <- if "GL_EXT_texture_object" `elem` exts
                   then fmap Just genObjectName
                   else return Nothing
   when (isJust mbTexName) $ textureBinding Texture2D $= mbTexName

   textureWrapMode Texture2D S $= (Repeated, Repeat)
   textureWrapMode Texture2D T $= (Repeated, Repeat)
   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)
   withImage c $ texImage2D Texture2D NoProxy 0 RGBA' (imageSize c) 0
   texture Texture2D $= Enabled
   return mbTexName

evolveC :: Conf a -> Conf a
evolveC c = c { state = evolve c $ state c }

display :: MVar (Conf a) -> Maybe TextureObject -> DisplayCallback
display mv mbTexName = do
  cstate <- readMVar mv
  clear [ ColorBuffer, DepthBuffer ]
  textureFunction $= Decal
  when (isJust mbTexName) $ textureBinding Texture2D $= mbTexName
  let texCoord2f = texCoord :: TexCoord2 GLfloat -> IO ()
      vertex3f   = vertex   :: Vertex3   GLfloat -> IO ()
  renderPrimitive Quads $ do
    texCoord2f (TexCoord2 0 0); vertex3f (Vertex3 (-1.0) (-1.0) 0.0 )
    texCoord2f (TexCoord2 0 1); vertex3f (Vertex3 1.0 (-1.0) 0.0 )
    texCoord2f (TexCoord2 1 1); vertex3f (Vertex3 1.0 1.0 0.0 )
    texCoord2f (TexCoord2 1 0); vertex3f (Vertex3 (-1.0) 1.0 0.0 )
  withImage cstate $ texImage2D Texture2D NoProxy 0 RGBA' (imageSize cstate) 0
  swapBuffers

reshape :: ReshapeCallback
reshape size@(Size w h) = do
  viewport $= (Position 0 0, size)
  matrixMode $= Projection
  loadIdentity
  perspective 60 (fromIntegral w / fromIntegral h) 1 1
  matrixMode $= Modelview 0
  loadIdentity
  translate (Vector3 0 0 (-1 :: GLfloat))

kmEncode :: Key -> KeyState -> Modifiers -> Position -> KMState
kmEncode (Char k)        Down _ _ = [k]
kmEncode (SpecialKey k)  Down _ _ = show k
kmEncode (MouseButton m) Down _ _ = show m
kmEncode _ _ _ _ = ""

keyboard :: MVar (Conf a) -> KeyboardMouseCallback
keyboard _ (Char '\27') Down _ _ = exitSuccess
keyboard mv k ks m p = do
  c <- readMVar mv
  let e = kmEncode k ks m p
  modifyMVar_ mv (keyBinds c e)

idle :: MVar (Conf a) -> IdleCallback
idle mv = do
  modifyMVar_ mv (return . evolveC)
  postRedisplay Nothing

runDisp :: Conf a -> IO ()
runDisp c = do
  cstate <- newMVar c
  (progName, _args) <- getArgsAndInitialize
  initialDisplayMode    $= [ DoubleBuffered, RGBMode, WithDepthBuffer ]
  initialWindowSize     $= Size 250 250
  initialWindowPosition $= Position 100 100
  _ <- createWindow progName
  tex <- myInit c
  displayCallback       $= display cstate tex
  reshapeCallback       $= Just reshape
  keyboardMouseCallback $= Just (keyboard cstate)
  idleCallback          $= Just (idle cstate)
  mainLoop

{-

module Main where

    import Graphics.GPipe
    import qualified Data.Vec as Vec
    import Data.Vec.Nat
    import Data.Vec.LinAlg.Transform3D
    import Data.Monoid
    import Data.IORef
    import Foreign.C.Types
    import Foreign.Marshal.Array
    import Graphics.UI.GLUT( Window,
                             mainLoop,
                             postRedisplay,
                             idleCallback,
                             getArgsAndInitialize,
                             ($=))

    triVerts = [ (-0.8):.0.8:.0.0:.(),
             0.8:.0.8:.0.0:.(),
             0.0:.(-0.8):.0.0:.() ]
    uvCoords = [ 0.0:.0.0:.(),
                 1.0:.0.0:.(),
                 0.5:.1.0:.() ]

    triangle :: PrimitiveStream Triangle (Vec3 (Vertex Float),Vec2 (Vertex Float))
    triangle = toGPUStream TriangleList $ zip triVerts uvCoords

    -- This implements the vertex shader
    procTriangle :: Vec2 Int -> PrimitiveStream Triangle (Vec4 (Vertex Float), Vec2 (Vertex Float))
    procTriangle size = fmap (projTriangle size) triangle

    projTriangle :: Vec2 Int -> (Vec3 (Vertex Float),Vec2 (Vertex Float)) -> (Vec4 (Vertex Float), Vec2 (Vertex Float))
    projTriangle size (pos,uv) = (orthoProj `multmv` homPos, uv)
        where homPos = homPoint pos :: Vec4 (Vertex Float)
              orthoProj = toGPU $ orthogonal (-10) 10  (2:.2:.())

    -- This implements the fragment shader
    rastTriangle :: Texture2D RGBFormat -> Vec2 Int -> FragmentStream (Color RGBFormat (Fragment Float))
    rastTriangle tex size = fmap (applyTex tex) $ rasterizeFrontAndBack $ procTriangle size

    applyTex tex (front,uv) = sample (Sampler Linear Wrap) tex uv

    triangleFrame :: Texture2D RGBFormat -> Vec2 Int -> FrameBuffer RGBFormat () ()
    triangleFrame tex size = draw (rastTriangle tex size) clear
        where
          draw  = paintColor NoBlending (RGB $ Vec.vec True)
          clear = newFrameBufferColor (RGB (0.1:.0.3:.0.6:.()))

    main :: IO ()
    main = do
      getArgsAndInitialize
      putStrLn "loading texture..."
      tex <- loadTexture demonHead
      putStrLn "creating window..."
      newWindow "Green Triangle"
           (100:.100:.())
           (800:.600:.())
           (renderFrame tex)
           initWindow
      putStrLn "entering mainloop..."
      mainLoop

    renderFrame :: Texture2D RGBFormat -> Vec2 Int -> IO (FrameBuffer RGBFormat () ())
    renderFrame tex size = do
              return $ triangleFrame tex size

    initWindow :: Window -> IO ()
    initWindow win = idleCallback $= Nothing --Just (postRedisplay (Just win))

    loadTexture' ptr = newTexture (PerComp3 UnsignedByteFormat) RGB8 (128:.128:.()) [ptr]
    loadTexture = flip withArray loadTexture'

    demonHead :: [CUChar]

-}


module Main where

-- base
import Control.Monad ( unless )
import Data.Monoid( (<>) )
import Control.Applicative( (<|>), (<**>) )
import System.IO ( stdin )

import Options.Applicative( Parser, strOption, optional, short, long
                          , flag', metavar, help, execParser, info
                          , fullDesc, header, helper, progDesc
                          , argument, str )

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS

import qualified Data.Vector as V

---- statistics
import Statistics.Sample ( range, mean, variance, stdDev, stdErrMean )

import System.Log.FastLogger( TimedFastLogger, ToLogStr, LogType'( LogStderr )
                            , defaultBufSize, newTimeCache, simpleTimeFormat
                            , toLogStr, newTimedFastLogger, withTimedFastLogger )

-- local library imports
import Data.Fits ( HeaderDataUnit(..), HeaderData(..), Axis(..)
                 , parsePix, isBitPixInt, isBitPixFloat, pixsUnwrapI, pixsUnwrapD )
import Data.Fits.MegaParser ( getAllHDUs )

-- | Paramaterized input type for files or standard input.
data Input = FileInput FilePath -- ^ The 'FileInput' constructor needs a path name
           | StdInput           -- ^ The `StdInput` constructor stands in for the obvious

-- | Parameterized output type for files or standard output.
data Output = FileOutput FilePath -- ^ When you have a file use 'FileOutput'
            | StdOutput           -- ^ For a screen dump use 'StdOutput'

fileInput :: Parser Input
fileInput = FileInput <$> argument str
    ( metavar "FILE"
   <> help "Input FITS file to parse" )

stdInput :: Parser Input
stdInput = flag' StdInput
    ( long "stdin"
   <> help "Input FITS from stdin" )

fileOutput :: Parser Output
fileOutput = FileOutput <$> strOption
    ( long "outfile"
   <> short 'o'
   <> help "Output filename to store" )

stdOutput :: Parser Output
stdOutput = flag' StdOutput
    ( long "stdout"
   <> help "Output picture to stdout" )

inputParse :: Parser Input
inputParse = fileInput <|> stdInput

outputParse :: Parser Output
outputParse = fileOutput <|> stdOutput

data FitsConfig = FitsConfig
    { infile :: Input
    , outImage :: Maybe Output
    }

fitsConfigParser :: Parser FitsConfig
fitsConfigParser = FitsConfig <$> inputParse <*> optional outputParse

main :: IO ()
main = workOnFITS =<< execParser opts
    where
        opts = info (fitsConfigParser <**> helper)
            ( fullDesc
           <> progDesc "Parse, generate, and render FITS files"
           <> header "fits-parse - a FITS swiss army knife" )

workOnFITS :: FitsConfig -> IO ()
workOnFITS (FitsConfig i o) = do
    timeCache <- newTimeCache simpleTimeFormat
    withTimedFastLogger timeCache (LogStderr defaultBufSize) $ \logger -> do
        fits <- bs i
        myLog logger $ "[DEBUG] input file size " ++ show (BS.length fits) ++ " bytes\n"
        hdus <- getAllHDUs fits
        myLog logger ("[DEBUG] found " ++ show (length hdus) ++ " hdu record(s)\n")
        mapM_ (processHDU logger) hdus
  where
    bs (FileInput f) = BS.readFile f
    bs StdInput = BS.hGetContents stdin

processHDU :: TimedFastLogger -> HeaderDataUnit -> IO ()
processHDU logger hdu = do
    myLog logger $ "[DEBUG] Bit Format " ++ show bpf ++ "\n"
    myLog logger $ "[DEBUG] data block size " ++ show (BS.length pd) ++ " bytes\n"
    myLog logger $ "[DEBUG] " ++ show (length ax) ++ " Axes\n"
    unless (null ax) (mapM_ logAxes ax)
    let pixCount = foldr (\x acc -> axisElementCount x * acc) 1 ax
    pixs <- parsePix pixCount bpf (LBS.fromStrict pd)
    let pxsI = if isBitPixInt bpf then pixsUnwrapI bpf pixs else []
        pxsD = if isBitPixFloat bpf then pixsUnwrapD bpf pixs else []
        pVI = V.fromList pxsI
        pVD = V.fromList pxsD
    myLog logger $ "[DEBUG] Total Pix Count: " ++ show (length pixs) ++ "\n"
    myLog logger $ "[DEBUG] Unwrapped Int Count: " ++ show (length pxsI) ++ "\n"
    myLog logger $ "[DEBUG] Unwrapped Double Count: " ++ show (length pxsD) ++ "\n"
    myLog logger $ "[DEBUG] Vector Int Count: " ++ show (length pVI) ++ "\n"
    myLog logger $ "[DEBUG] Vector Double Count: " ++ show (length pVD) ++ "\n"
    if (length ax == 2) && isBitPixFloat bpf
      then
        bitMapProcess logger ax pVD
      else
        myLog logger "[DEBUG] skipping bitmap analysis.\n"

  where
    hd = headerData hdu
    pd = payloadData hdu
    ax = axes hd
    bpf = bitPixFormat hd
    logAxes a = myLog logger $ "[DEBUG] Axis: "
                            ++ show (axisNumber a)
                            ++ " count: "
                            ++ show (axisElementCount a) ++ "\n"

{- | If we happen to be working in floating point 2D, let's try the
     following.
-}
bitMapProcess :: TimedFastLogger
              -> [Axis]          -- ^ Metadata about the column oriented axes
              -> V.Vector Double -- ^ Data is stored in column-row major order
              -> IO ()
bitMapProcess logger []  _    = myLog logger "[ERROR] BitMap processing run with no axes.\n"
bitMapProcess logger [_] _    = myLog logger "[ERROR] BitMap processing run with only one axis.\n"
bitMapProcess logger (y:x) v = do
  myLog logger $ "[DEBUG] Mean:     " ++ show (mean v) ++ "\n"
  myLog logger $ "[DEBUG] Range:    " ++ show (range v) ++ "\n"
  myLog logger $ "[DEBUG] Variance: " ++ show (variance v) ++ "\n"
  myLog logger $ "[DEBUG] Std deviation: " ++ show (stdDev v) ++ "\n"
  myLog logger $ "[DEBUG] Std error of the mean: " ++ show (stdErrMean v) ++ "\n"

myLog:: ToLogStr msg => TimedFastLogger -> msg -> IO ()
myLog logger msg = logger $ \ft -> toLogStr ft <> toLogStr ": " <> toLogStr msg


{-# LANGUAGE TemplateHaskell #-}

module School.App.Test.CSVReader
( csvReaderTest ) where

import Conduit ((.|), runConduit, sinkList)
import Control.Monad.IO.Class (liftIO)
import Data.Either (isRight)
import Data.List.Split (chunksOf)
import School.App.CSVReader
import School.FileIO.AppIO (runAppIO)
import School.FileIO.FileHeader (FileHeader(..))
import School.FileIO.Source (source)
import School.Types.DataType (DataType(..))
import qualified Numeric.LinearAlgebra as NL
import System.Directory (removeFile)
import Test.QuickCheck.Monadic (assert, monadicIO, run)
import Test.Tasty.QuickCheck
import Test.Tasty (TestTree)
import Test.Tasty.TH

matrixConcat :: (NL.Element a)
             => [NL.Matrix a]
             -> Either String [NL.Matrix a]
matrixConcat [] = return []
matrixConcat matrices = do
  let nCols = NL.cols . head $ matrices
  let compat = all (\m -> NL.cols m == nCols) matrices
  if not compat then Left "Matrices must have same # columns"
    else do
      let allRows = concat . concat $ map NL.toLists matrices
      return [NL.fromLists (chunksOf nCols allRows)]

prop_convert_csv_file :: Property
prop_convert_csv_file = monadicIO $ do
  let filePath = "test/data/csvTest.csv"
  let bFileName = "test.dat"
  let header = FileHeader DBL64B 51 3
  writeRes <- run . runAppIO . runConduit $
    csvToBinary filePath bFileName header
  assert $ isRight writeRes
  readRes <- run . runAppIO . runConduit $
      readCSV filePath
     .| csvToMatrixDouble header
     .| sinkList
  let original = readRes >>= matrixConcat
  written <- run . runAppIO . runConduit $
    source header bFileName .| sinkList
  liftIO $ removeFile bFileName
  assert $ original == written

csvReaderTest :: TestTree
csvReaderTest = $(testGroupGenerator)


{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{-| This module defines a version of `Representable` where the function
    tabulated/indexed returns a monadic result.

    In other words, instead of providing an isomorphism with `Reader`,
    we provide one with `ReaderT` for a fixed `Monad`.
-}

module Control.Monad.Rep (
  -- * Type class
    RepresentableM(..)

  -- * Functor
  , fmapRepM

  -- * Distributive
  , distributeRepM
  , collectRepM

  -- * DistributiveM
  , distributemRepM
  , collectmRepM

  -- * Apply/Applicative
  , apRepM
  , pureRepM
  , liftRM2
  , liftRM3

  -- * Bind/Monad
  , bindRepM

  -- * MonadFix
  , mfixRepM

  -- * MonadZip
  , mzipWithRepM
  , mzipRepM

  -- * MonadReader
  , fromReaderT
  , toReaderT
  , askRepM
  , asksRepM
  , mapRepM
  , withRepM
  , localRepM

  -- * Extend
  , duplicatedRepM
  , extendedRepM

  -- * Comonad
  , duplicateRepM
  , extendRepM
  , extractRepM

  -- * Comonad, with user-specified monoid
  , duplicateRepMBy
  , extendRepMBy
  , extractRepMBy

  -- * WithIndex
  , imapRepM
  , imapMRepM
  , ifoldMapRepM
  , itraverseRepM

  -- * MonadFree
  , wrapRepM

  -- * Lifting other operations
  , liftRepM
  , liftCallCC
  , liftCatch

  -- * Generics
  , gtabulateM
  , gindexM

  , GRepM
  , GRepM'
  , GTabulateM(..)
  , GIndexM(..)
  , WrappedRepM(..)

  , todo
  ) where

import Control.Comonad (Comonad(..))
import Control.Monad (liftM2, liftM3)
import Control.Monad.Fix (MonadFix(..))
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Zip (MonadZip(..))
import Data.Bits (Bits, FiniteBits)
import Data.Complex (Complex)
import Data.Data (Data)
import Data.Distributive (Distributive(..))
import Data.Distributive.Monadic
import Data.Foldable (fold)
import Data.Functor.Compose (Compose(..))
import Data.Functor.Identity (Identity(..))
import Data.Ix (Ix)
import Data.Profunctor.Unsafe (Profunctor(..))
import Data.Proxy (Proxy(..))
import Data.Semigroup (Dual, Product, Semigroup(..), Sum)
import Data.Typeable (Typeable)
import Data.Void (Void, absurd)
import Foreign.Storable (Storable)
import GHC.Generics
  ( (:*:)(..)
  , (:.:)(..)
  , Generic
  , Generic1(..)
  , M1(..)
  , Par1(..)
  , Rec1(..)
  , U1(..)
  )
import GHC.TypeLits (ErrorMessage(..), TypeError)
import Text.Printf (PrintfArg)

-- There are a number of "boring", i.e. trivial, instances:
-- Monad m => RepresentableM m (WrappedMonad m) where
--   type RepM (WrappedMonad m) = ()
--   tabulateM f = WrappedMonad (f ())
--   indexM = const
-- ..

-- | A `Functor` @f@ is `RepresentableM` for a given `Monad` @m@ if `tabulateM`
-- and `indexM` witness an isomorphism to @`ReaderT` (`RepM` f) m@.
--
-- @
--  `tabulateM` . `indexM` == `id`
--  `indexM` . `tabulateM` == `id`
--  `tabulateM` . `return` . `return` == `return`
-- @
--
-- Every `RepresentableM` `Functor` whose base `Monad` is a right adjoint
-- is also a right adjoint.
--
-- Inuitively, a `RepresentableM` `Functor` is a `Representable` `Functor` on
-- the Kleisli category of the base `Monad`.
--
-- I'd expect some superclass requirement, but it ends up looking like just
-- @`Applicative` f@:
--
-- @
-- class `Applicative` f => DistributiveA f where
--   distributeM :: `Traversable` t => t (f a) -> f (t a)
--
-- instance `Applicative` m => DistributiveM (`ReaderT` a m) where
--   distributeM = `ReaderT` . `fmap` `sequenceA` . `distribute` . `fmap` `runReaderT`
-- @
--
class DistributiveM m f => RepresentableM m f | f -> m where
  -- | If no definition is provided, this will default to `GRepM`.
  type RepM f :: *
  type RepM f = GRepM f

  -- |
  -- @
  --  `fmap` (`fmap` f) . `tabulateM` == `tabulateM` . `fmap` f
  -- @
  --
  -- If no definition is provided, this will default to `gtabulateM`.
  tabulateM :: (RepM f -> m a) -> f a
  default tabulateM :: (Generic1 f, GRepM f ~ RepM f, GTabulateM m (Rep1 f)) => (RepM f -> m a) -> f a
  tabulateM = gtabulateM

  -- | If no definition is provided, this will default to 'gindexM'.
  indexM :: f a -> (RepM f -> m a)
  default indexM :: (Generic1 f, GRepM f ~ RepM f, GIndexM m (Rep1 f)) => f a -> (RepM f -> m a)
  indexM = gindexM

-- GHC.Generics instances

instance (RepresentableM m f, RepresentableM m g) =>
         RepresentableM m (f :*: g)

instance (RepresentableM m f, RepresentableM m g, Monad (f :.: g), Functor f) =>
         RepresentableM m (f :.: g)

instance (RepresentableM m f, RepresentableM m g, Monad (Compose f g), Functor f) =>
         RepresentableM m (Compose f g)

instance RepresentableM Identity Par1

instance RepresentableM m f => RepresentableM m (M1 i c f)

instance RepresentableM m f => RepresentableM m (Rec1 f)

instance RepresentableM Identity U1

-- Lifted instances

instance RepresentableM Identity Identity

instance RepresentableM Identity Complex

instance RepresentableM Identity Dual

instance RepresentableM Identity Sum

instance RepresentableM Identity Product

instance RepresentableM Identity Proxy

-- Interesting instances

instance Monad m => RepresentableM m (ReaderT a m) where
  type RepM (ReaderT a m) = a
  tabulateM = ReaderT
  indexM = runReaderT

-- instance Monad m => RepresentableM m (FoldM m a) where
--   type RepM (FoldM m a) = FoldableFree a
--   tabulateM = fromFunctionM
--   indexM = foldM

-- -- | Hmm, instead of `fromFunctionEM`, shouldn't we be able
-- -- to encode a function like `lineE` using it?
-- instance RepresentableM m (FoldEM m a) where
--   type RepM (FoldEM m a) = FoldableFree a
--   tabulateM = fromFunctionEM
--   indexM = foldEM

--   type RepM (CofreeM m) = Free Maybe (RepM f)
--   indexM (_ :< xs) (Pure k) = indexM xs k
--   indexM (x :< _ ) (Free Nothing) = return x
--   indexM (_ :< xs) (Free (Just k)) = xs >>= (`indexM` k)

--   tabulateM f = f Nothing :< _ f

-- Functor

-- | `fmap` inside the `Monad`ic result of a `RepresentableM`
fmapRepM :: RepresentableM m f => (a -> b) -> f a -> f b
fmapRepM f = tabulateM . fmap (fmap f) . indexM

-- Distributive

-- | `collect` after `indexM`ing
distributeRepM :: (RepresentableM m f, Distributive m, Functor w) => w (f a) -> f (w a)
distributeRepM wf = tabulateM $ \k -> collect (`indexM` k) wf

-- | `collect` after `indexM`ing the result of the provided function
collectRepM :: (RepresentableM m f, Distributive m, Functor w) => (a -> f b) -> w a -> f (w b)
collectRepM f w = tabulateM $ \k -> collect ((`indexM` k) . f) w

-- DistributiveM

-- | `distributem` for `RepresentableM`
distributemRepM :: RepresentableM m f => m (f a) -> f (m a)
distributemRepM = tabulateM . collect indexM

-- | `collect` for `RepresentableM`
collectmRepM :: RepresentableM m f => (a -> f b) -> m a -> f (m b)
collectmRepM f = tabulateM . collect indexM . fmap f

-- Apply/Applicative

-- | Uses the isomorphism
apRepM :: RepresentableM m f => f (a -> b) -> f a -> f b
apRepM f g = tabulateM $ liftM2 (<*>) (indexM f) (indexM g)

-- | `tabulateM` ignoring the index and `return`ing the value
pureRepM :: RepresentableM m f => a -> f a
pureRepM = tabulateM . const . return

-- | Uses the isomorphism
liftRM2 :: RepresentableM m f => (a -> b -> c) -> f a -> f b -> f c
liftRM2 f fa fb = tabulateM $ \k -> liftM2 f (indexM fa k) (indexM fb k)

-- | Uses the isomorphism
liftRM3 :: RepresentableM m f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftRM3 f fa fb fc = tabulateM $ \k -> liftM3 f (indexM fa k) (indexM fb k) (indexM fc k)

-- Bind/Monad

-- | Equivalent to:
--
-- @
--  \\m f -> `runReaderT` $ `toReaderT` m `>>=` `toReaderT` . f
-- @
--
bindRepM :: RepresentableM m f => f a -> (a -> f b) -> f b
bindRepM m f = tabulateM $ \k -> f <$> indexM m k >>= (`indexM` k)

-- MonadFix

-- | Equivalent to:
--
-- @
--  `runReaderT` . `mfix` . `fmap` `toReaderT`
-- @
--
mfixRepM :: (RepresentableM m f, MonadFix m) => (a -> f a) -> f a
mfixRepM = fromReaderT . mfix . fmap toReaderT

-- MonadZip

-- | `indexM`, `mzipWith`, then `tabulateM`
mzipWithRepM :: (RepresentableM m f, MonadZip m) => (a -> b -> c) -> f a -> f b -> f c
mzipWithRepM f as bs = tabulateM $ \k -> mzipWith f (indexM as k) (indexM bs k)

-- | `indexM`, `mzip`, then `tabulateM`
mzipRepM :: (RepresentableM m f, MonadZip m) => f a -> f b -> f (a, b)
mzipRepM as bs = tabulateM $ \k -> mzip (indexM as k) (indexM bs k)

-- MonadReader

-- | @`RepresentableM` m f@ is isomorphic to @`ReaderT` (`RepM` f) m a@:
--
-- @
--  `fromReaderT` . `toReaderT` == `id`
--  `toReaderT` . `fromReaderT` == `id`
-- @
--
fromReaderT :: RepresentableM m f => ReaderT (RepM f) m a -> f a
fromReaderT = tabulateM . runReaderT

-- | The other half of the isomorphism, see: `fromReaderT`
toReaderT :: RepresentableM m f => f a -> ReaderT (RepM f) m a
toReaderT = ReaderT . indexM

-- | Fetch the value of the environment.
--
-- (`ask` specialized to `RepresentableM`)
askRepM :: RepresentableM m f => f (RepM f)
askRepM = tabulateM return

-- | Retrieve a function of the current environment.
--
-- (`asks` specialized to `RepresentableM`)
asksRepM :: RepresentableM m f
         => (RepM f -> a)  -- ^ The selector function to apply to the environment.
         -> f a
asksRepM = tabulateM . fmap return

-- | Transform the computation inside a `RepresentableM`.
--
-- (`mapReaderT` specialized to `RepresentableM`)
mapRepM :: RepresentableM m f => (m a -> m b) -> f a -> f b
mapRepM f xs = tabulateM $ f . indexM xs

-- | Execute a computation in a modified environment.
--
-- (`withReaderT` specialized to `RepresentableM`)
withRepM :: RepresentableM m f
         => (RepM f -> RepM f)  -- ^ The function to modify the environment.
         -> f a                 -- ^ Computation to run in the modified environment.
         -> f a
withRepM f m = tabulateM $ indexM m . f

-- | Execute a computation in a modified environment.
--
-- (`local` specialized to `RepresentableM`)
localRepM :: RepresentableM m f
          => (RepM f -> RepM f) -- ^ The function to modify the environment.
          -> f a                -- ^ Computation to run in the modified environment.
          -> f a
localRepM = withRepM

-- Extend

-- | @`duplicateRepMBy` (`<>`)@
duplicatedRepM :: (RepresentableM m f, Semigroup (RepM f)) => f a -> f (f a)
duplicatedRepM = duplicateRepMBy (<>)

-- | @`extendRepMBy` (`<>`)@
extendedRepM :: (RepresentableM m f, Semigroup (RepM f)) => (f a -> b) -> f a -> f b
extendedRepM = extendRepMBy (<>)

-- Comonad

-- | @`duplicateRepMBy` `mappend`@
duplicateRepM :: (RepresentableM m f, Monoid (RepM f)) => f a -> f (f a)
duplicateRepM = duplicateRepMBy mappend

-- | @`extendRepMBy` `mappend`@
extendRepM :: (RepresentableM m f, Monoid (RepM f)) => (f a -> b) -> f a -> f b
extendRepM = extendRepMBy mappend

-- | @`extractRepMBy` `mempty`@
extractRepM :: (RepresentableM m f, Monoid (RepM f), Comonad m) => f a -> a
extractRepM = extractRepMBy mempty

-- Comonad, with user-specified monoid

-- | `indexM` then `tabulateM` twice and use the provided operation to
-- combine the keys
duplicateRepMBy :: RepresentableM m f => (RepM f -> RepM f -> RepM f) -> f a -> f (f a)
duplicateRepMBy plus w = tabulateM (\k -> return $ tabulateM (indexM w . plus k))

-- | `indexM` then `tabulateM` twice and use the provided operation to
-- combine the keys
extendRepMBy :: RepresentableM m f => (RepM f -> RepM f -> RepM f) -> (f a -> b) -> f a -> f b
extendRepMBy plus f w = tabulateM (\k -> return $ f (tabulateM (indexM w . plus k)))

-- | Since we need to return a raw value, @m@ must be a `Comonad`
extractRepMBy :: (RepresentableM m f, Comonad m) => RepM f -> f a -> a
extractRepMBy = fmap extract . flip indexM

-- WithIndex

-- | `tabulateM` to expose the `RepM` and then `fmap`
imapRepM :: RepresentableM m f => (RepM f -> a -> b) -> f a -> f b
imapRepM f xs = tabulateM $ \k -> f k <$> indexM xs k

-- | `tabulateM` to expose the `RepM` and then (`>>=`)
imapMRepM :: RepresentableM m f => (RepM f -> a -> m b) -> f a -> f b
imapMRepM f xs = tabulateM $ \k -> indexM xs k >>= f k

-- | Indexed `foldMap`
ifoldMapRepM :: forall m f a b. (RepresentableM m f, Foldable f, Monoid b) => (RepM f -> a -> b) -> f a -> b
ifoldMapRepM ix xs = fold ((tabulateM $ \(k :: RepM f) -> ix k <$> indexM xs k) :: f b)

-- | Indexed `traverse`
itraverseRepM :: (RepresentableM m f, Traversable f, Applicative g) => (RepM f -> a -> g b) -> f a -> g (f b)
itraverseRepM ix xs = sequenceA . tabulateM $ \k -> ix k <$> indexM xs k

-- MonadFree

-- | Wrap the base `Monad` of a `RepresentableM`
wrapRepM :: RepresentableM m f => m (f a) -> f a
wrapRepM m = tabulateM $ \k -> m >>= (`indexM` k)

-- Lifting other operations

-- | Lift the base `Monad` of a `RepresentableM`
liftRepM :: RepresentableM m f => m a -> f a
liftRepM = tabulateM . const

-- | Lift a @callCC@ operation to the base `Monad`.
liftCallCC :: RepresentableM m f
           => (((a -> m b) -> m a) -> m a) -- ^ @callCC@ on the base `Monad`.
           -> ((a -> f b) -> f a)
           -> f a
liftCallCC callCC f =
  tabulateM $ \k -> callCC $ \c -> indexM (f (tabulateM . const . c)) k

-- | Lift a @catchError@ operation to the base monad.
liftCatch :: RepresentableM m f
          => (m a -> (RepM f -> m a) -> m a) -- ^ @catch@ on the base monad.
          -> f a                             -- ^ Computation to attempt.
          -> (RepM f -> f a)                 -- ^ Exception handler.
          -> f a
liftCatch catch m handle =
  tabulateM $ \k -> indexM m k `catch` \e -> indexM (handle e) k

-- Generics

-- | A default implementation of `tabulateM` in terms of `GRepM`.
gtabulateM ::
     (Generic1 f, GRepM f ~ RepM f, GTabulateM m (Rep1 f))
  => (RepM f -> m a)
  -> f a
gtabulateM = to1 . gtabulateM'

-- | A default implementation of `indexM` in terms of `GRepM`.
gindexM ::
     (Generic1 f, GRepM f ~ RepM f, GIndexM m (Rep1 f))
  => f a
  -> (RepM f -> m a)
gindexM = gindexM' . from1

-- | A convenient composition of `GRepM'` and `Rep1`
type GRepM f = GRepM' (Rep1 f)

-- | Generic `RepM`, with a customer `TypeError` for unsupported types.
type family GRepM' (f :: * -> *) :: * where
  GRepM' (f :*: g) = Either (GRepM' f) (GRepM' g)
  GRepM' Par1 = ()
  GRepM' (M1 i c f) = GRepM' f
  GRepM' (f :.: g) = (WrappedRepM f, GRepM' g)
  GRepM' (Rec1 f) = WrappedRepM f
  GRepM' U1 = Void
  GRepM' x = TypeError (
      'Text "The type " ':<>:
      'ShowType x ':<>:
      'Text " is not one of (:*:), (:.:), Par1, M1, Rec1, or U1."
    )

-- | The typeclass implementing `gtabulateM` (as `gtabulateM'`)
-- for `Generic` types
class Monad m => GTabulateM (m :: * -> *) (f :: * -> *) | f -> m where
  gtabulateM' :: (GRepM' f -> m a) -> f a

instance (GTabulateM m f, GTabulateM m g) => GTabulateM m (f :*: g) where
  gtabulateM' f = gtabulateM' (f . Left) :*: gtabulateM' (f . Right)

instance GTabulateM Identity Par1 where
  gtabulateM' = Par1 . runIdentity . extract

instance GTabulateM m f => GTabulateM m (M1 i c f) where
  gtabulateM' = M1 #. gtabulateM'

instance (RepresentableM m f, GTabulateM m g) => GTabulateM m (f :.: g) where
  gtabulateM' f =
    Comp1 $ tabulateM $ fmap (return . gtabulateM') $ fmap (curry f) WrapRepM

instance RepresentableM m f => GTabulateM m (Rec1 f) where
  gtabulateM' = Rec1 #. tabulateM .# (. WrapRepM)

-- | The monadic side-effects must be thrown out,
-- so the `Monad` must be `Identity`
instance GTabulateM Identity U1 where
  gtabulateM' _ = U1

-- | The typeclass implementing `gindexM` (as `gindexM'`)
-- for `Generic` types
class Monad m => GIndexM (m :: * -> *) (f :: * -> *) | f -> m where
  gindexM' :: f a -> (GRepM' f -> m a)

instance (GIndexM m f, GIndexM m g) => GIndexM m (f :*: g) where
  gindexM' ~(a :*: _)  (Left  i) = gindexM' a i
  gindexM' ~(_ :*: b) ~(Right j) = gindexM' b j

instance GIndexM Identity Par1 where
  gindexM' (Par1 a) () = Identity a

instance GIndexM m f => GIndexM m (M1 i c f) where
  gindexM' = gindexM' .# unM1

instance (RepresentableM m f, GIndexM m g) => GIndexM m (f :.: g) where
  gindexM' (Comp1 fg) ~(i, j) = (indexM fg .# unwrapRepM) i >>= (`gindexM'` j)

instance RepresentableM m f => GIndexM m (Rec1 f) where
  gindexM' = (. unwrapRepM) #. indexM .# unRec1

-- `absurd`
instance GIndexM Identity U1 where
  gindexM' U1 = absurd

-- | `WrappedRepM` prevents generic `RepresentableM` instances for
-- recursive types from sending the typechecker into an infinite loop.
--
-- See `WrappedRep`.
newtype WrappedRepM f = WrapRepM { unwrapRepM :: RepM f }

deriving instance Bits (RepM f) => Bits (WrappedRepM f)

deriving instance Bounded (RepM f) => Bounded (WrappedRepM f)

deriving instance (Data (RepM f), Typeable f) => Data (WrappedRepM f)

deriving instance Enum (RepM f) => Enum (WrappedRepM f)

deriving instance Eq (RepM f) => Eq (WrappedRepM f)

deriving instance FiniteBits (RepM f) => FiniteBits (WrappedRepM f)

deriving instance Floating (RepM f) => Floating (WrappedRepM f)

deriving instance Fractional (RepM f) => Fractional (WrappedRepM f)

deriving instance Generic (RepM f) => Generic (WrappedRepM f)

deriving instance Ix (RepM f) => Ix (WrappedRepM f)

deriving instance Monoid (RepM f) => Monoid (WrappedRepM f)

deriving instance Num (RepM f) => Num (WrappedRepM f)

deriving instance Ord (RepM f) => Ord (WrappedRepM f)

deriving instance PrintfArg (RepM f) => PrintfArg (WrappedRepM f)

deriving instance Read (RepM f) => Read (WrappedRepM f)

deriving instance Real (RepM f) => Real (WrappedRepM f)

deriving instance RealFloat (RepM f) => RealFloat (WrappedRepM f)

deriving instance RealFrac (RepM f) => RealFrac (WrappedRepM f)

deriving instance Semigroup (RepM f) => Semigroup (WrappedRepM f)

deriving instance Show (RepM f) => Show (WrappedRepM f)

deriving instance Storable (RepM f) => Storable (WrappedRepM f)

deriving instance Typeable (RepM f) => Typeable (WrappedRepM f)

-- | `Cofree`, `CofreeT` instances
todo :: ()
todo = ()