module Data.Internal.Wkb.Endian
  ( EndianType (..)
  , getEndianType
  , getFourBytes
  , getDouble
  , builderEndianType
  , builderFourBytes
  , builderDouble
  ) where

import qualified Control.Monad           as Monad
import qualified Data.Binary.Get         as BinaryGet
import qualified Data.ByteString.Builder as ByteStringBuilder
import qualified Data.Word               as Word

data EndianType = LittleEndian | BigEndian deriving (Int -> EndianType -> ShowS
[EndianType] -> ShowS
EndianType -> String
(Int -> EndianType -> ShowS)
-> (EndianType -> String)
-> ([EndianType] -> ShowS)
-> Show EndianType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EndianType] -> ShowS
$cshowList :: [EndianType] -> ShowS
show :: EndianType -> String
$cshow :: EndianType -> String
showsPrec :: Int -> EndianType -> ShowS
$cshowsPrec :: Int -> EndianType -> ShowS
Show, EndianType -> EndianType -> Bool
(EndianType -> EndianType -> Bool)
-> (EndianType -> EndianType -> Bool) -> Eq EndianType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EndianType -> EndianType -> Bool
$c/= :: EndianType -> EndianType -> Bool
== :: EndianType -> EndianType -> Bool
$c== :: EndianType -> EndianType -> Bool
Eq)

getEndianType :: BinaryGet.Get EndianType
getEndianType :: Get EndianType
getEndianType = do
  Word8
byte <- Get Word8
BinaryGet.getWord8
  case Word8
byte of
    Word8
0 ->
      EndianType -> Get EndianType
forall (f :: * -> *) a. Applicative f => a -> f a
pure EndianType
BigEndian
    Word8
1 ->
      EndianType -> Get EndianType
forall (f :: * -> *) a. Applicative f => a -> f a
pure EndianType
LittleEndian
    Word8
_ ->
      String -> Get EndianType
forall (m :: * -> *) a. MonadFail m => String -> m a
Monad.fail String
"Invalid EndianType"

getFourBytes :: EndianType -> BinaryGet.Get Word.Word32
getFourBytes :: EndianType -> Get Word32
getFourBytes EndianType
endianType =
  case EndianType
endianType of
    EndianType
LittleEndian ->
      Get Word32
BinaryGet.getWord32le
    EndianType
BigEndian ->
      Get Word32
BinaryGet.getWord32be

getDouble :: EndianType -> BinaryGet.Get Double
getDouble :: EndianType -> Get Double
getDouble EndianType
endianType =
  case EndianType
endianType of
    EndianType
LittleEndian ->
      Get Double
BinaryGet.getDoublele
    EndianType
BigEndian ->
      Get Double
BinaryGet.getDoublebe

builderEndianType :: EndianType -> ByteStringBuilder.Builder
builderEndianType :: EndianType -> Builder
builderEndianType EndianType
BigEndian    = Word8 -> Builder
ByteStringBuilder.word8 Word8
0
builderEndianType EndianType
LittleEndian = Word8 -> Builder
ByteStringBuilder.word8 Word8
1

builderFourBytes :: EndianType -> Word.Word32 -> ByteStringBuilder.Builder
builderFourBytes :: EndianType -> Word32 -> Builder
builderFourBytes EndianType
endianType =
  case EndianType
endianType of
    EndianType
LittleEndian ->
      Word32 -> Builder
ByteStringBuilder.word32LE
    EndianType
BigEndian ->
      Word32 -> Builder
ByteStringBuilder.word32BE

builderDouble :: EndianType -> Double -> ByteStringBuilder.Builder
builderDouble :: EndianType -> Double -> Builder
builderDouble EndianType
endianType =
  case EndianType
endianType of
    EndianType
LittleEndian ->
      Double -> Builder
ByteStringBuilder.doubleLE
    EndianType
BigEndian ->
      Double -> Builder
ByteStringBuilder.doubleBE