    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE DerivingStrategies #-}
    {-# LANGUAGE GADTSyntax #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE KindSignatures #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE RoleAnnotations #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE StandaloneDeriving #-}
    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE UnboxedTuples #-}

    {- | This module offers an interface to portably work with byte
    arrays whose contents are known to be of a fixed endianness.
    There are two ways to use this module:

    * Untyped Conversions: The functions 'toBigEndian', 'toLittleEndian',
      'fromBigEndian', and 'fromLittleEndian' convert between native-endian
      words and big/little-endian words. The word resulting from
      @to(Big|Little)Endian@ should be written to a primitive byte
      array or a pointer afterwards. (There is no other purpose of
      such a conversion.) Similarly, the argument to @from(Big|Little)Endian@
      should be a word that was read from a primitive byte array or
      a pointer. This interface is useful when serializing or deserializing
      a data structure with fields of varying sizes.
    * Typed Conversions: The type 'Fixed' provides a convenient
      type-directed interface to working with arrays of homogenous words.
      This interface is easier to use and should be preferred when
      possible.

    The example at the bottom of this page demonstrates how to use the
    type-directed interface.
    -}
    module System.ByteOrder
      ( -- * Types
        ByteOrder (..)
      , Fixed (..)

        -- * Classes
      , Bytes
      , FixedOrdering

        -- * Conversion
      , toBigEndian
      , toLittleEndian
      , fromBigEndian
      , fromLittleEndian

        -- * System Byte Order
      , targetByteOrder

        -- * Example
        -- $example
      ) where

    import Data.Kind (Type)
    import Data.Primitive.ByteArray.Unaligned (PrimUnaligned)
    import Data.Primitive.Types (Prim)
    import Foreign.Ptr (Ptr, castPtr)
    import Foreign.Storable (Storable)
    import GHC.ByteOrder (ByteOrder (..), targetByteOrder)
    import System.ByteOrder.Class (Bytes (..), FixedOrdering, toFixedEndian)

    import qualified Data.Primitive.ByteArray.Unaligned as PMU
    import qualified Data.Primitive.Types as PM
    import qualified Foreign.Storable as FS

    -- | Convert from a big-endian word to a native-endian word.
    fromBigEndian :: (Bytes a) => a -> a
    fromBigEndian :: forall a. Bytes a => a -> a
    fromBigEndian = a -> a
    forall a. Bytes a => a -> a
    toBigEndian

    -- | Convert from a little-endian word to a native-endian word.
    fromLittleEndian :: (Bytes a) => a -> a
    fromLittleEndian :: forall a. Bytes a => a -> a
    fromLittleEndian = a -> a
    forall a. Bytes a => a -> a
    toLittleEndian

    {- | A word whose byte order is specified (not platform dependent)
    when working with 'Prim', 'Storable', and @PrimUnaligned@ (this
    last instance is provided alongside the typeclass itself in the
    @primitive-unaligned@ library).
    -}
    newtype Fixed :: ByteOrder -> Type -> Type where
      Fixed :: forall (b :: ByteOrder) (a :: Type). {forall (b :: ByteOrder) a. Fixed b a -> a
    getFixed :: a} -> Fixed b a

    type role Fixed phantom representational

    deriving newtype instance (Num a) => Num (Fixed b a)
    deriving newtype instance (Real a) => Real (Fixed b a)
    deriving newtype instance (Integral a) => Integral (Fixed b a)
    deriving newtype instance (Ord a) => Ord (Fixed b a)
    deriving newtype instance (Enum a) => Enum (Fixed b a)
    deriving newtype instance (Eq a) => Eq (Fixed b a)

    instance (FixedOrdering b, Prim a, Bytes a) => Prim (Fixed b a) where
      {-# INLINE sizeOf# #-}
      {-# INLINE alignment# #-}
      {-# INLINE indexByteArray# #-}
      {-# INLINE readByteArray# #-}
      {-# INLINE writeByteArray# #-}
      {-# INLINE setByteArray# #-}
      {-# INLINE indexOffAddr# #-}
      {-# INLINE readOffAddr# #-}
      {-# INLINE writeOffAddr# #-}
      {-# INLINE setOffAddr# #-}
      sizeOf# :: Fixed b a -> Int#
    sizeOf# Fixed b a
    _ = a -> Int#
    forall a. Prim a => a -> Int#
    PM.sizeOf# (a
    forall a. HasCallStack => a
    undefined :: a)
      alignment# :: Fixed b a -> Int#
    alignment# Fixed b a
    _ = a -> Int#
    forall a. Prim a => a -> Int#
    PM.alignment# (a
    forall a. HasCallStack => a
    undefined :: a)
      indexByteArray# :: ByteArray# -> Int# -> Fixed b a
    indexByteArray# ByteArray#
    a Int#
    i = a -> Fixed b a
    forall (b :: ByteOrder) a. a -> Fixed b a
    Fixed (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b (ByteArray# -> Int# -> a
    forall a. Prim a => ByteArray# -> Int# -> a
    PM.indexByteArray# ByteArray#
    a Int#
    i))
      readByteArray# :: forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, Fixed b a #)
    readByteArray# MutableByteArray# s
    a Int#
    i State# s
    s0 = case MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
    forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
    forall a s.
    Prim a =>
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
    PM.readByteArray# MutableByteArray# s
    a Int#
    i State# s
    s0 of
        (# State# s
    s1, a
    x #) -> (# State# s
    s1, a -> Fixed b a
    forall (b :: ByteOrder) a. a -> Fixed b a
    Fixed (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b a
    x) #)
      writeByteArray# :: forall s.
    MutableByteArray# s -> Int# -> Fixed b a -> State# s -> State# s
    writeByteArray# MutableByteArray# s
    a Int#
    i (Fixed a
    x) = MutableByteArray# s -> Int# -> a -> State# s -> State# s
    forall s. MutableByteArray# s -> Int# -> a -> State# s -> State# s
    forall a s.
    Prim a =>
    MutableByteArray# s -> Int# -> a -> State# s -> State# s
    PM.writeByteArray# MutableByteArray# s
    a Int#
    i (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b a
    x)
      setByteArray# :: forall s.
    MutableByteArray# s
    -> Int# -> Int# -> Fixed b a -> State# s -> State# s
    setByteArray# MutableByteArray# s
    a Int#
    i Int#
    n (Fixed a
    x) = MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
    forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
    forall a s.
    Prim a =>
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
    PM.setByteArray# MutableByteArray# s
    a Int#
    i Int#
    n (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b a
    x)
      indexOffAddr# :: Addr# -> Int# -> Fixed b a
    indexOffAddr# Addr#
    a Int#
    i = a -> Fixed b a
    forall (b :: ByteOrder) a. a -> Fixed b a
    Fixed (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b (Addr# -> Int# -> a
    forall a. Prim a => Addr# -> Int# -> a
    PM.indexOffAddr# Addr#
    a Int#
    i))
      readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Fixed b a #)
    readOffAddr# Addr#
    a Int#
    i State# s
    s0 = case Addr# -> Int# -> State# s -> (# State# s, a #)
    forall s. Addr# -> Int# -> State# s -> (# State# s, a #)
    forall a s.
    Prim a =>
    Addr# -> Int# -> State# s -> (# State# s, a #)
    PM.readOffAddr# Addr#
    a Int#
    i State# s
    s0 of
        (# State# s
    s1, a
    x #) -> (# State# s
    s1, a -> Fixed b a
    forall (b :: ByteOrder) a. a -> Fixed b a
    Fixed (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b a
    x) #)
      writeOffAddr# :: forall s. Addr# -> Int# -> Fixed b a -> State# s -> State# s
    writeOffAddr# Addr#
    a Int#
    i (Fixed a
    x) = Addr# -> Int# -> a -> State# s -> State# s
    forall s. Addr# -> Int# -> a -> State# s -> State# s
    forall a s. Prim a => Addr# -> Int# -> a -> State# s -> State# s
    PM.writeOffAddr# Addr#
    a Int#
    i (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b a
    x)
      setOffAddr# :: forall s.
    Addr# -> Int# -> Int# -> Fixed b a -> State# s -> State# s
    setOffAddr# Addr#
    a Int#
    i Int#
    n (Fixed a
    x) = Addr# -> Int# -> Int# -> a -> State# s -> State# s
    forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s
    forall a s.
    Prim a =>
    Addr# -> Int# -> Int# -> a -> State# s -> State# s
    PM.setOffAddr# Addr#
    a Int#
    i Int#
    n (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b a
    x)

    instance (FixedOrdering b, PrimUnaligned a, Bytes a) => PrimUnaligned (Fixed b a) where
      {-# INLINE indexUnalignedByteArray# #-}
      {-# INLINE readUnalignedByteArray# #-}
      {-# INLINE writeUnalignedByteArray# #-}
      indexUnalignedByteArray# :: ByteArray# -> Int# -> Fixed b a
    indexUnalignedByteArray# ByteArray#
    a Int#
    i = a -> Fixed b a
    forall (b :: ByteOrder) a. a -> Fixed b a
    Fixed (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b (ByteArray# -> Int# -> a
    forall a. PrimUnaligned a => ByteArray# -> Int# -> a
    PMU.indexUnalignedByteArray# ByteArray#
    a Int#
    i))
      readUnalignedByteArray# :: forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, Fixed b a #)
    readUnalignedByteArray# MutableByteArray# s
    a Int#
    i State# s
    s0 = case MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
    forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
    forall a s.
    PrimUnaligned a =>
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
    PMU.readUnalignedByteArray# MutableByteArray# s
    a Int#
    i State# s
    s0 of
        (# State# s
    s1, a
    x #) -> (# State# s
    s1, a -> Fixed b a
    forall (b :: ByteOrder) a. a -> Fixed b a
    Fixed (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b a
    x) #)
      writeUnalignedByteArray# :: forall s.
    MutableByteArray# s -> Int# -> Fixed b a -> State# s -> State# s
    writeUnalignedByteArray# MutableByteArray# s
    a Int#
    i (Fixed a
    x) = MutableByteArray# s -> Int# -> a -> State# s -> State# s
    forall s. MutableByteArray# s -> Int# -> a -> State# s -> State# s
    forall a s.
    PrimUnaligned a =>
    MutableByteArray# s -> Int# -> a -> State# s -> State# s
    PMU.writeUnalignedByteArray# MutableByteArray# s
    a Int#
    i (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b a
    x)

    instance (FixedOrdering b, Storable a, Bytes a) => Storable (Fixed b a) where
      {-# INLINE sizeOf #-}
      {-# INLINE alignment #-}
      {-# INLINE peekElemOff #-}
      {-# INLINE pokeElemOff #-}
      {-# INLINE peekByteOff #-}
      {-# INLINE pokeByteOff #-}
      {-# INLINE peek #-}
      {-# INLINE poke #-}
      sizeOf :: Fixed b a -> Int
    sizeOf Fixed b a
    _ = a -> Int
    forall a. Storable a => a -> Int
    FS.sizeOf (a
    forall a. HasCallStack => a
    undefined :: a)
      alignment :: Fixed b a -> Int
    alignment Fixed b a
    _ = a -> Int
    forall a. Storable a => a -> Int
    FS.alignment (a
    forall a. HasCallStack => a
    undefined :: a)
      peekElemOff :: Ptr (Fixed b a) -> Int -> IO (Fixed b a)
    peekElemOff Ptr (Fixed b a)
    p Int
    i = (a -> Fixed b a) -> IO a -> IO (Fixed b a)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a -> Fixed b a
    forall (b :: ByteOrder) a. a -> Fixed b a
    Fixed (a -> Fixed b a) -> (a -> a) -> a -> Fixed b a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b) (Ptr a -> Int -> IO a
    forall a. Storable a => Ptr a -> Int -> IO a
    FS.peekElemOff (Ptr (Fixed b a) -> Ptr a
    forall (b :: ByteOrder) a. Ptr (Fixed b a) -> Ptr a
    fromFixedPtr Ptr (Fixed b a)
    p) Int
    i)
      pokeElemOff :: Ptr (Fixed b a) -> Int -> Fixed b a -> IO ()
    pokeElemOff Ptr (Fixed b a)
    p Int
    i (Fixed a
    x) = Ptr a -> Int -> a -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    FS.pokeElemOff (Ptr (Fixed b a) -> Ptr a
    forall (b :: ByteOrder) a. Ptr (Fixed b a) -> Ptr a
    fromFixedPtr Ptr (Fixed b a)
    p) Int
    i (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b a
    x)
      peekByteOff :: forall b. Ptr b -> Int -> IO (Fixed b a)
    peekByteOff Ptr b
    p Int
    i = (a -> Fixed b a) -> IO a -> IO (Fixed b a)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a -> Fixed b a
    forall (b :: ByteOrder) a. a -> Fixed b a
    Fixed (a -> Fixed b a) -> (a -> a) -> a -> Fixed b a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b) (Ptr b -> Int -> IO a
    forall b. Ptr b -> Int -> IO a
    forall a b. Storable a => Ptr b -> Int -> IO a
    FS.peekByteOff Ptr b
    p Int
    i)
      pokeByteOff :: forall b. Ptr b -> Int -> Fixed b a -> IO ()
    pokeByteOff Ptr b
    p Int
    i (Fixed a
    x) = Ptr b -> Int -> a -> IO ()
    forall b. Ptr b -> Int -> a -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    FS.pokeByteOff Ptr b
    p Int
    i (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b a
    x)
      peek :: Ptr (Fixed b a) -> IO (Fixed b a)
    peek Ptr (Fixed b a)
    p = (a -> Fixed b a) -> IO a -> IO (Fixed b a)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a -> Fixed b a
    forall (b :: ByteOrder) a. a -> Fixed b a
    Fixed (a -> Fixed b a) -> (a -> a) -> a -> Fixed b a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b) (Ptr a -> IO a
    forall a. Storable a => Ptr a -> IO a
    FS.peek (Ptr (Fixed b a) -> Ptr a
    forall (b :: ByteOrder) a. Ptr (Fixed b a) -> Ptr a
    fromFixedPtr Ptr (Fixed b a)
    p))
      poke :: Ptr (Fixed b a) -> Fixed b a -> IO ()
    poke Ptr (Fixed b a)
    p (Fixed a
    x) = Ptr a -> a -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    FS.poke (Ptr (Fixed b a) -> Ptr a
    forall (b :: ByteOrder) a. Ptr (Fixed b a) -> Ptr a
    fromFixedPtr Ptr (Fixed b a)
    p) (forall (b :: ByteOrder) a. (FixedOrdering b, Bytes a) => a -> a
    toFixedEndian @b a
    x)

    fromFixedPtr :: Ptr (Fixed b a) -> Ptr a
    {-# INLINE fromFixedPtr #-}
    fromFixedPtr :: forall (b :: ByteOrder) a. Ptr (Fixed b a) -> Ptr a
    fromFixedPtr = Ptr (Fixed b a) -> Ptr a
    forall a b. Ptr a -> Ptr b
    castPtr

    {- $example
    Suppose there is a protocol for aggregating numbers that uses stream
    sockets for communication. The protocol interprets all numbers as
    unsigned. It is described as follows:

    1. The client sends the server a little-endian 16-bit number @N@.
       This is how many numbers will follow.
    2. The client sends @N@ little-endian 64-bit numbers to the server.
    3. The server responds with two little-endian 64-bit numbers:
       the sum and the product of the @N@ numbers it received.

    Assume the existence of a @send@ and @receive@ that block until
    the total number of requested bytes have been handled. They both
    work on their argument arrays starting at index zero, which ensures
    that any 2-byte, 4-byte, or 8-byte types will be aligned properly.
    (GHC always machine-word aligns the payload of a byte array.)
    Additionally, assume the @typed@ and @untyped@ functions that convert between
    'PrimArray' and 'ByteArray' by changing out the data constructor.

    > send :: Socket -> ByteArray -> IO ()
    > receive :: Socket -> Int -> IO ByteArray
    > typed :: ByteArray -> PrimArray a
    > untyped :: PrimArray a -> ByteArray

    For simplicity, all error-handling is omitted. With the type-directed
    interface, the server is implemented as:

    > import Data.Primitive.ByteArray
    > import Data.Primitive.PrimArray
    > import System.ByteOrder
    >
    > server :: Socket -> IO a
    > server sckt = forever $ do
    >   totalByteArray <- receive sckt 2
    >   let totalPrimArray = typed totalByteArray :: PrimArray (Fixed 'LittleEndian Word16)
    >   let Fixed total = indexPrimArray totalPrimArray 0
    >   numberByteArray <- receive sckt (8 * fromIntegral @Word16 @Int total)
    >   let (sum,prod) = foldlPrimArray'
    >         (\(!sumN,!prodN) (Fixed n) -> (sumN + n, prodN * n))
    >         (0,1)
    >         (typed numberByteArray :: PrimArray (Fixed 'LittleEndian Word64))
    >   reply :: MutablePrimArray RealWorld (Fixed 'LittleEndian Word64) <- newPrimArray 2
    >   writePrimArray reply 0 (Fixed sum)
    >   writePrimArray reply 1 (Fixed prod)
    >   send sckt . untyped =<< unsafeFreezePrimArray reply

    Not every explicit type annotation above is needed. Some are provided
    for the reader's benefit. As long as the user ensures that the
    typed primitive arrays use 'Fixed' in their element types, the endianness
    conversions are guaranteed to be correct.
    -}