-- Util.hs ---

-- Copyright (C) 2020 Nerd Ed

-- Author: Nerd Ed <nerded.nerded@gmail.com>

-- This program is free software; you can redistribute it and/or
-- modify it under the terms of the GNU General Public License
-- as published by the Free Software Foundation; either version 3
-- of the License, or (at your option) any later version.

-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.

-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE DerivingStrategies  #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

-- |
-- = This handy module extend Storable typeclasse with default instances for C-like enums/fixed arrays (FFI).
--
-- Using 'StorableExt', we are now able to use deriving via clause on sum types.
--
-- @
-- data X
--   = A
--   | B
--   | C
--   deriving stock Enum
--   deriving Storable via StorableExt X
-- @
--
-- This type will be stored as a word32 (C enum FFI).
--
module Zydis.Util
  ( StorableExt(..)
  , Storable
  )
where

import           Data.Vector.Fixed.Storable
import           Data.Word
import           Foreign.Ptr
import           Foreign.Storable

-- | Wrapper to extend storable default instances.
newtype StorableExt a =
  StorableExt
    { StorableExt a -> a
unStorableExt :: a
    }
  deriving stock (Int -> StorableExt a -> ShowS
[StorableExt a] -> ShowS
StorableExt a -> String
(Int -> StorableExt a -> ShowS)
-> (StorableExt a -> String)
-> ([StorableExt a] -> ShowS)
-> Show (StorableExt a)
forall a. Show a => Int -> StorableExt a -> ShowS
forall a. Show a => [StorableExt a] -> ShowS
forall a. Show a => StorableExt a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorableExt a] -> ShowS
$cshowList :: forall a. Show a => [StorableExt a] -> ShowS
show :: StorableExt a -> String
$cshow :: forall a. Show a => StorableExt a -> String
showsPrec :: Int -> StorableExt a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> StorableExt a -> ShowS
Show, StorableExt a -> StorableExt a -> Bool
(StorableExt a -> StorableExt a -> Bool)
-> (StorableExt a -> StorableExt a -> Bool) -> Eq (StorableExt a)
forall a. Eq a => StorableExt a -> StorableExt a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorableExt a -> StorableExt a -> Bool
$c/= :: forall a. Eq a => StorableExt a -> StorableExt a -> Bool
== :: StorableExt a -> StorableExt a -> Bool
$c== :: forall a. Eq a => StorableExt a -> StorableExt a -> Bool
Eq)

instance forall a. Enum a => Storable (StorableExt a) where
  alignment :: StorableExt a -> Int
alignment = Int -> StorableExt a -> Int
forall a b. a -> b -> a
const (Int -> StorableExt a -> Int) -> Int -> StorableExt a -> Int
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a. Storable a => a -> Int
alignment @Word32 Word32
forall a. HasCallStack => a
undefined
  sizeOf :: StorableExt a -> Int
sizeOf = Int -> StorableExt a -> Int
forall a b. a -> b -> a
const (Int -> StorableExt a -> Int) -> Int -> StorableExt a -> Int
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a. Storable a => a -> Int
sizeOf @Word32 Word32
forall a. HasCallStack => a
undefined
  peek :: Ptr (StorableExt a) -> IO (StorableExt a)
peek = (Word32 -> StorableExt a) -> IO Word32 -> IO (StorableExt a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> StorableExt a
forall a. a -> StorableExt a
StorableExt (a -> StorableExt a) -> (Word32 -> a) -> Word32 -> StorableExt a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> (Word32 -> Int) -> Word32 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO Word32 -> IO (StorableExt a))
-> (Ptr (StorableExt a) -> IO Word32)
-> Ptr (StorableExt a)
-> IO (StorableExt a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word32 -> IO Word32)
-> (Ptr (StorableExt a) -> Ptr Word32)
-> Ptr (StorableExt a)
-> IO Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (StorableExt a) -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr @_ @Word32
  poke :: Ptr (StorableExt a) -> StorableExt a -> IO ()
poke Ptr (StorableExt a)
ptr StorableExt a
v =
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (StorableExt a) -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr @_ @Word32 Ptr (StorableExt a)
ptr) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Enum a => a -> Int
fromEnum (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ StorableExt a -> a
forall a. StorableExt a -> a
unStorableExt StorableExt a
v)