    {- |
    Here we show an example of how to
    define a Storable instance with this module.

    > import Foreign.Storable.Record as Store
    > import Foreign.Storable (Storable (..), )
    >
    > import Control.Applicative (liftA2, )
    >
    > data Stereo a = Stereo {left, right :: a}
    >
    > store :: Storable a => Store.Dictionary (Stereo a)
    > store =
    >    Store.run $
    >    liftA2 Stereo
    >       (Store.element left)
    >       (Store.element right)
    >
    > instance (Storable a) => Storable (Stereo a) where
    >    sizeOf = Store.sizeOf store
    >    alignment = Store.alignment store
    >    peek = Store.peek store
    >    poke = Store.poke store

    The @Stereo@ constructor is exclusively used
    for constructing the @peek@ function,
    whereas the accessors in the @element@ calls
    are used for assembling the @poke@ function.
    It is required that the order of arguments of @Stereo@
    matches the record accessors in the @element@ calls.
    If you want that the stored data correctly and fully represents
    your Haskell data, it must hold:

    >   Stereo (left x) (right x) = x   .

    Unfortunately this cannot be checked automatically.
    However, mismatching types that are caused by swapped arguments
    are detected by the type system.
    Our system performs for you:
    Size and alignment computation, poking and peeking.
    Thus several inconsistency bugs can be prevented using this package,
    like size mismatching the space required by @poke@ actions.
    There is no more restriction,
    thus smart constructors and accessors
    and nested records work, too.
    For nested records however,
    I recommend individual Storable instances for the sub-records.

    You see it would simplify class instantiation
    if we could tell the class dictionary at once
    instead of defining each method separately.

    In this implementation we choose the minimum size for a record,
    that is we omit tail padding,
    which saves space but is incompatible with Linux/X86 ABI.
    -}
    module Foreign.Storable.RecordMinimalSize (
       Dictionary, Access,
       element, run,

       alignment, sizeOf,
       peek, poke,
       ) where

    import Control.Monad.Trans.Reader
              (ReaderT(ReaderT), runReaderT,
               Reader, reader, runReader, )
    import Control.Monad.Trans.Writer
              (Writer, writer, runWriter, )
    import Control.Monad.Trans.State
              (State, modify, get, runState, )
    import Control.Applicative (Applicative(pure, (<*>)), )
    import Data.Functor.Compose (Compose(Compose), )
    import Data.Monoid (Monoid(mempty, mappend), )
    import Data.Semigroup (Semigroup((<>)), )

    import Foreign.Storable.FixedArray (roundUp, )
    import qualified Foreign.Storable as St

    import Foreign.Ptr (Ptr, )
    import Foreign.Storable (Storable, )

    data Dictionary r =
       Dictionary {
          Dictionary r -> Int
    sizeOf_ :: Int,
          Dictionary r -> Alignment
    alignment_ :: Alignment,
          Dictionary r -> Reader (Ptr r) (Box r r)
    ptrBox :: Reader (Ptr r) (Box r r)
       }

    newtype Access r a =
       Access
          (Compose (Writer Alignment)
            (Compose (State Int)
              (Compose (Reader (Ptr r))
                  (Box r)))
            a)

    instance Functor (Access r) where
       {-# INLINE fmap #-}
       fmap :: (a -> b) -> Access r a -> Access r b
    fmap f :: a -> b
    f (Access m :: Compose
      (Writer Alignment)
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
      a
    m) = Compose
      (Writer Alignment)
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
      b
    -> Access r b
    forall r a.
    Compose
      (Writer Alignment)
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
      a
    -> Access r a
    Access ((a -> b)
    -> Compose
         (Writer Alignment)
         (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
         a
    -> Compose
         (Writer Alignment)
         (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
         b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f Compose
      (Writer Alignment)
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
      a
    m)

    instance Applicative (Access r) where
       {-# INLINE pure #-}
       {-# INLINE (<*>) #-}
       pure :: a -> Access r a
    pure a :: a
    a = Compose
      (Writer Alignment)
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
      a
    -> Access r a
    forall r a.
    Compose
      (Writer Alignment)
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
      a
    -> Access r a
    Access (a
    -> Compose
         (Writer Alignment)
         (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
         a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    a)
       Access f :: Compose
      (Writer Alignment)
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
      (a -> b)
    f <*> :: Access r (a -> b) -> Access r a -> Access r b
    <*> Access x :: Compose
      (Writer Alignment)
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
      a
    x = Compose
      (Writer Alignment)
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
      b
    -> Access r b
    forall r a.
    Compose
      (Writer Alignment)
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
      a
    -> Access r a
    Access (Compose
      (Writer Alignment)
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
      (a -> b)
    f Compose
      (Writer Alignment)
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
      (a -> b)
    -> Compose
         (Writer Alignment)
         (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
         a
    -> Compose
         (Writer Alignment)
         (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
         b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Compose
      (Writer Alignment)
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
      a
    x)

    data Box r a =
       Box {
          Box r a -> IO a
    peek_ :: IO a,
          Box r a -> ReaderT r IO ()
    poke_ :: ReaderT r IO ()
       }

    instance Functor (Box r) where
       {-# INLINE fmap #-}
       fmap :: (a -> b) -> Box r a -> Box r b
    fmap f :: a -> b
    f (Box pe :: IO a
    pe po :: ReaderT r IO ()
    po) =
          IO b -> ReaderT r IO () -> Box r b
    forall r a. IO a -> ReaderT r IO () -> Box r a
    Box ((a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f IO a
    pe) ReaderT r IO ()
    po

    instance Applicative (Box r) where
       {-# INLINE pure #-}
       {-# INLINE (<*>) #-}
       pure :: a -> Box r a
    pure a :: a
    a = IO a -> ReaderT r IO () -> Box r a
    forall r a. IO a -> ReaderT r IO () -> Box r a
    Box (a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    a) (() -> ReaderT r IO ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ())
       f :: Box r (a -> b)
    f <*> :: Box r (a -> b) -> Box r a -> Box r b
    <*> x :: Box r a
    x = IO b -> ReaderT r IO () -> Box r b
    forall r a. IO a -> ReaderT r IO () -> Box r a
    Box (Box r (a -> b) -> IO (a -> b)
    forall r a. Box r a -> IO a
    peek_ Box r (a -> b)
    f IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Box r a -> IO a
    forall r a. Box r a -> IO a
    peek_ Box r a
    x) (Box r (a -> b) -> ReaderT r IO ()
    forall r a. Box r a -> ReaderT r IO ()
    poke_ Box r (a -> b)
    f ReaderT r IO () -> ReaderT r IO () -> ReaderT r IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Box r a -> ReaderT r IO ()
    forall r a. Box r a -> ReaderT r IO ()
    poke_ Box r a
    x)

    newtype Alignment = Alignment Int

    instance Semigroup Alignment where
       {-# INLINE (<>) #-}
       Alignment x :: Int
    x <> :: Alignment -> Alignment -> Alignment
    <> Alignment y :: Int
    y = Int -> Alignment
    Alignment (Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    lcm Int
    x Int
    y)

    instance Monoid Alignment where
       {-# INLINE mempty #-}
       {-# INLINE mappend #-}
       mempty :: Alignment
    mempty = Int -> Alignment
    Alignment 1
       mappend :: Alignment -> Alignment -> Alignment
    mappend = Alignment -> Alignment -> Alignment
    forall a. Semigroup a => a -> a -> a
    (<>)

    {-# INLINE element #-}
    element :: Storable a => (r -> a) -> Access r a
    element :: (r -> a) -> Access r a
    element f :: r -> a
    f =
       let align :: Int
    align = a -> Int
    forall a. Storable a => a -> Int
    St.alignment (r -> a
    f ([Char] -> r
    forall a. HasCallStack => [Char] -> a
    error "Storable.Record.element.alignment: content touched"))
           size :: Int
    size  = a -> Int
    forall a. Storable a => a -> Int
    St.sizeOf (r -> a
    f ([Char] -> r
    forall a. HasCallStack => [Char] -> a
    error "Storable.Record.element.size: content touched"))
       in  Compose
      (Writer Alignment)
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
      a
    -> Access r a
    forall r a.
    Compose
      (Writer Alignment)
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
      a
    -> Access r a
    Access (Compose
       (Writer Alignment)
       (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
       a
     -> Access r a)
    -> Compose
         (Writer Alignment)
         (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
         a
    -> Access r a
    forall a b. (a -> b) -> a -> b
    $
           WriterT
      Alignment
      Identity
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a)
    -> Compose
         (Writer Alignment)
         (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
         a
    forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
    f (g a) -> Compose f g a
    Compose (WriterT
       Alignment
       Identity
       (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a)
     -> Compose
          (Writer Alignment)
          (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
          a)
    -> WriterT
         Alignment
         Identity
         (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a)
    -> Compose
         (Writer Alignment)
         (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)))
         a
    forall a b. (a -> b) -> a -> b
    $ (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a,
     Alignment)
    -> WriterT
         Alignment
         Identity
         (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a)
    forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
    writer ((Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a,
      Alignment)
     -> WriterT
          Alignment
          Identity
          (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a))
    -> (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a,
        Alignment)
    -> WriterT
         Alignment
         Identity
         (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a)
    forall a b. (a -> b) -> a -> b
    $ (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a
     -> Alignment
     -> (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a,
         Alignment))
    -> Alignment
    -> Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a
    -> (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a,
        Alignment)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (,) (Int -> Alignment
    Alignment Int
    align) (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a
     -> (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a,
         Alignment))
    -> Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a
    -> (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a,
        Alignment)
    forall a b. (a -> b) -> a -> b
    $
           StateT Int Identity (Compose (Reader (Ptr r)) (Box r) a)
    -> Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a
    forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
    f (g a) -> Compose f g a
    Compose (StateT Int Identity (Compose (Reader (Ptr r)) (Box r) a)
     -> Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a)
    -> StateT Int Identity (Compose (Reader (Ptr r)) (Box r) a)
    -> Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) a
    forall a b. (a -> b) -> a -> b
    $ do
              (Int -> Int) -> StateT Int Identity ()
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
    modify (Int -> Int -> Int
    roundUp Int
    align)
              Int
    offset <- StateT Int Identity Int
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
              (Int -> Int) -> StateT Int Identity ()
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
    modify (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    size)
              Compose (Reader (Ptr r)) (Box r) a
    -> StateT Int Identity (Compose (Reader (Ptr r)) (Box r) a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Compose (Reader (Ptr r)) (Box r) a
     -> StateT Int Identity (Compose (Reader (Ptr r)) (Box r) a))
    -> Compose (Reader (Ptr r)) (Box r) a
    -> StateT Int Identity (Compose (Reader (Ptr r)) (Box r) a)
    forall a b. (a -> b) -> a -> b
    $
                 ReaderT (Ptr r) Identity (Box r a)
    -> Compose (Reader (Ptr r)) (Box r) a
    forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
    f (g a) -> Compose f g a
    Compose (ReaderT (Ptr r) Identity (Box r a)
     -> Compose (Reader (Ptr r)) (Box r) a)
    -> ReaderT (Ptr r) Identity (Box r a)
    -> Compose (Reader (Ptr r)) (Box r) a
    forall a b. (a -> b) -> a -> b
    $ (Ptr r -> Box r a) -> ReaderT (Ptr r) Identity (Box r a)
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    reader ((Ptr r -> Box r a) -> ReaderT (Ptr r) Identity (Box r a))
    -> (Ptr r -> Box r a) -> ReaderT (Ptr r) Identity (Box r a)
    forall a b. (a -> b) -> a -> b
    $ \ptr :: Ptr r
    ptr ->
                    IO a -> ReaderT r IO () -> Box r a
    forall r a. IO a -> ReaderT r IO () -> Box r a
    Box
                      (Ptr r -> Int -> IO a
    forall a b. Storable a => Ptr b -> Int -> IO a
    St.peekByteOff Ptr r
    ptr Int
    offset)
                      ((r -> IO ()) -> ReaderT r IO ()
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
    ReaderT ((r -> IO ()) -> ReaderT r IO ())
    -> (r -> IO ()) -> ReaderT r IO ()
    forall a b. (a -> b) -> a -> b
    $ Ptr r -> Int -> a -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    St.pokeByteOff Ptr r
    ptr Int
    offset (a -> IO ()) -> (r -> a) -> r -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . r -> a
    f)

    {-# INLINE run #-}
    run :: Access r r -> Dictionary r
    run :: Access r r -> Dictionary r
    run (Access (Compose m :: Writer
      Alignment
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) r)
    m)) =
       let (Compose s :: State Int (Compose (Reader (Ptr r)) (Box r) r)
    s, align :: Alignment
    align) = Writer
      Alignment
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) r)
    -> (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) r,
        Alignment)
    forall w a. Writer w a -> (a, w)
    runWriter Writer
      Alignment
      (Compose (State Int) (Compose (Reader (Ptr r)) (Box r)) r)
    m
           (Compose r :: Reader (Ptr r) (Box r r)
    r, size :: Int
    size) = State Int (Compose (Reader (Ptr r)) (Box r) r)
    -> Int -> (Compose (Reader (Ptr r)) (Box r) r, Int)
    forall s a. State s a -> s -> (a, s)
    runState State Int (Compose (Reader (Ptr r)) (Box r) r)
    s 0
       in  Int -> Alignment -> Reader (Ptr r) (Box r r) -> Dictionary r
    forall r.
    Int -> Alignment -> Reader (Ptr r) (Box r r) -> Dictionary r
    Dictionary Int
    size Alignment
    align Reader (Ptr r) (Box r r)
    r

    {-# INLINE alignment #-}
    alignment :: Dictionary r -> r -> Int
    alignment :: Dictionary r -> r -> Int
    alignment dict :: Dictionary r
    dict _ =
       let (Alignment align :: Int
    align) = Dictionary r -> Alignment
    forall r. Dictionary r -> Alignment
    alignment_ Dictionary r
    dict
       in  Int
    align

    {-# INLINE sizeOf #-}
    sizeOf :: Dictionary r -> r -> Int
    sizeOf :: Dictionary r -> r -> Int
    sizeOf dict :: Dictionary r
    dict _ =
       Dictionary r -> Int
    forall r. Dictionary r -> Int
    sizeOf_ Dictionary r
    dict

    {-# INLINE peek #-}
    peek :: Dictionary r -> Ptr r -> IO r
    peek :: Dictionary r -> Ptr r -> IO r
    peek dict :: Dictionary r
    dict ptr :: Ptr r
    ptr =
       Box r r -> IO r
    forall r a. Box r a -> IO a
    peek_ (Box r r -> IO r) -> Box r r -> IO r
    forall a b. (a -> b) -> a -> b
    $ Reader (Ptr r) (Box r r) -> Ptr r -> Box r r
    forall r a. Reader r a -> r -> a
    runReader (Dictionary r -> Reader (Ptr r) (Box r r)
    forall r. Dictionary r -> Reader (Ptr r) (Box r r)
    ptrBox Dictionary r
    dict) Ptr r
    ptr

    {-# INLINE poke #-}
    poke :: Dictionary r -> Ptr r -> r -> IO ()
    poke :: Dictionary r -> Ptr r -> r -> IO ()
    poke dict :: Dictionary r
    dict ptr :: Ptr r
    ptr =
       ReaderT r IO () -> r -> IO ()
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT (Box r r -> ReaderT r IO ()
    forall r a. Box r a -> ReaderT r IO ()
    poke_ (Box r r -> ReaderT r IO ()) -> Box r r -> ReaderT r IO ()
    forall a b. (a -> b) -> a -> b
    $ Reader (Ptr r) (Box r r) -> Ptr r -> Box r r
    forall r a. Reader r a -> r -> a
    runReader (Dictionary r -> Reader (Ptr r) (Box r r)
    forall r. Dictionary r -> Reader (Ptr r) (Box r r)
    ptrBox Dictionary r
    dict) Ptr r
    ptr)