{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans      #-}
{-|
 - This module provides a conversion function between a
 - 'Flake' and a lazy 'ByteString'.
-}

module Data.Snowchecked.Encoding.ByteString.Lazy
	( module Data.Snowchecked.Encoding.Class
	) where

import           Data.ByteString.Lazy
import           Data.Snowchecked.Encoding.Class
import           Data.Snowchecked.Encoding.Integral ()
import           Data.Snowchecked.Internal.Import
import           Prelude                            hiding (foldr)

integerToBS :: Integer -> ByteString
integerToBS :: Integer -> ByteString
integerToBS = [Word8] -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {a}. (Integral t, Num a, Bits t) => t -> [a]
mkBytes
	where
		mkBytes :: t -> [a]
mkBytes t
0 = forall a. Monoid a => a
mempty
		mkBytes t
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral t
n
			forall a. a -> [a] -> [a]
: t -> [a]
mkBytes (t
n forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
{-# INLINE integerToBS #-}

bsToInteger :: ByteString -> Integer
bsToInteger :: ByteString -> Integer
bsToInteger = forall a. (Word8 -> a -> a) -> a -> ByteString -> a
foldr Word8 -> Integer -> Integer
mkInteger Integer
0
	where
		mkInteger :: Word8 -> Integer -> Integer
		mkInteger :: Word8 -> Integer -> Integer
mkInteger Word8
nxt Integer
memo = (Integer
memo forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> a -> a
.|. forall a. Integral a => a -> Integer
toInteger Word8
nxt
{-# INLINE bsToInteger #-}

instance IsFlake ByteString where
	fromFlake :: Flake -> ByteString
fromFlake = Integer -> ByteString
integerToBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsFlake a => Flake -> a
fromFlake
	{-# INLINE fromFlake #-}

	parseFish :: forall (m :: * -> *).
MonadFail m =>
SnowcheckedConfig -> ByteString -> m Flakeish
parseFish SnowcheckedConfig
cfg = forall a (m :: * -> *).
(IsFlake a, MonadFail m) =>
SnowcheckedConfig -> a -> m Flakeish
parseFish SnowcheckedConfig
cfg forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Integer
bsToInteger
	{-# INLINE parseFish #-}