{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}

module Data.Primitive.Bool 
  ( BoolByte(..)
  ) where

import Data.Primitive.Types
import qualified Data.Primitive.Types as P
import Data.Word
import GHC.Prim 
import GHC.Types (Int(..))

{-@ data BoolByte = BoolByte { getBoolByte :: Bool } @-}
newtype BoolByte = BoolByte { getBoolByte :: Bool }

toBool :: Word8 -> BoolByte
toBool w = case w of
  0 -> BoolByte False
  _ -> BoolByte True
{-# INLINE toBool #-}

toBool# :: Word# -> BoolByte
toBool# w# = case eqWord# w# 0## of
  0# -> BoolByte False
  _  -> BoolByte True
{-# INLINE toBool# #-}

fromBool# :: BoolByte -> Word#
fromBool# (BoolByte b) = case b of
  True -> 1##
  False -> 0##
{-# INLINE fromBool# #-}

fromBool :: BoolByte -> Word8
fromBool (BoolByte b) = case b of
  True -> 1
  False -> 0

instance Prim BoolByte where
  sizeOf# _ = 1#
  alignment# _ = 1#
  indexByteArray# arr# i# = toBool# (indexWord8Array# arr# i#)               
  readByteArray# arr# i# s# = 
    case readWord8Array# arr# i# s# of        
      { (# s1#, x# #) -> (# s1#, toBool# x# #) }  
  writeByteArray# arr# i# b s# = 
    writeWord8Array# arr# i# (fromBool# b) s#    
  setByteArray# arr# i# n# b s# = P.setByteArray# arr# i# n# (fromBool b) s#
  indexOffAddr# addr# i# = toBool (indexOffAddr# addr# i#)
  readOffAddr#  addr# i# s# = 
    case readOffAddr# addr# i# s# of
      (# s1#, w #) -> (# s1#, toBool w #)
  writeOffAddr# addr# i# b s# = writeOffAddr# addr# i# (fromBool b) s#
  setOffAddr# addr# i# n# b s# = 
    setOffAddr# addr# i# n# (fromBool b) s#
  {-# INLINE sizeOf# #-}                                        
  {-# INLINE alignment# #-}                                     
  {-# INLINE indexByteArray# #-}                                
  {-# INLINE readByteArray# #-}                                 
  {-# INLINE writeByteArray# #-}                                
  {-# INLINE setByteArray# #-}                                  
  {-# INLINE indexOffAddr# #-}                                  
  {-# INLINE readOffAddr# #-}                                   
  {-# INLINE writeOffAddr# #-}                                  
  {-# INLINE setOffAddr# #-}