Util.hs

-- | Internal module. Not part of the public API.
module Database.Bolty.Util
  ( chunksOfBSL
  , chunksOfBS
  , putTextUtf8
  , decodeStrict
  , encodeStrict
  , lazyByteStringToHex
  , whenInvalid
  ) where

import           Control.Exception.Extra          (Partial)
import           Data.ByteString.Builder          (toLazyByteString, lazyByteStringHex)
import           Data.Int                         (Int64)
import           Data.List.Split                  (chunksOf)
import           Data.Persist                     (Put, HasEndianness, putByteString, runPut, runGet, putBE, getBE)
import           Data.Word8                       (toUpper)
import qualified Data.ByteString                  as BS
import qualified Data.ByteString.Lazy             as BSL
import qualified Data.Text                        as T
import qualified Data.Text.Encoding               as T
import qualified Validation                       as V


-- | Split a lazy 'BSL.ByteString' into chunks of at most @n@ bytes.
chunksOfBSL :: Partial => Int64 -> BSL.ByteString -> [BSL.ByteString]
chunksOfBSL i _ | i <= 0 = error $ "chunksOf, number must be positive, got " ++ show i
chunksOfBSL i xs = repeatedlyBSL (BSL.splitAt i) xs

-- | Split a strict 'BS.ByteString' into chunks of at most @n@ bytes.
chunksOfBS :: Partial => Int -> BS.ByteString -> [BS.ByteString]
chunksOfBS i _ | i <= 0 = error $ "chunksOf, number must be positive, got " ++ show i
chunksOfBS i xs = repeatedlyBS (BS.splitAt i) xs

repeatedlyBSL :: (BSL.ByteString -> (b, BSL.ByteString)) -> BSL.ByteString -> [b]
repeatedlyBSL f bs
    | BSL.null bs = []
    | otherwise   = b : repeatedlyBSL f bs'
  where (b, bs') = f bs

repeatedlyBS :: (BS.ByteString -> (b, BS.ByteString)) -> BS.ByteString -> [b]
repeatedlyBS f bs
    | BS.null bs = []
    | otherwise  = b : repeatedlyBS f bs'
  where (b, bs') = f bs


-- | Encode 'T.Text' as raw UTF-8 bytes into the 'Put' monad.
putTextUtf8 :: T.Text -> Put ()
putTextUtf8 = putByteString . T.encodeUtf8

-- | Decode a big-endian value from a strict 'BS.ByteString', throwing on failure.
decodeStrict :: forall a. HasEndianness a => BS.ByteString -> a
decodeStrict bs = case runGet (getBE @a) bs of
  Left e  -> error $ "decodeStrict: " ++ e
  Right v -> v

-- | Encode a value as a big-endian strict 'BS.ByteString'.
encodeStrict :: HasEndianness a => a -> BS.ByteString
encodeStrict = runPut . putBE


-- | Convert a lazy 'BSL.ByteString' to an uppercase hex-encoded strict 'BS.ByteString'.
lazyByteStringToHex :: BSL.ByteString -> BS.ByteString
lazyByteStringToHex bs = BS.intercalate " " $ map BS.pack $ Data.List.Split.chunksOf 2 $ map toUpper $ BS.unpack $ BSL.toStrict $ toLazyByteString $ lazyByteStringHex bs


-- | Return 'V.Failure' with the given error when the condition is 'True', otherwise 'V.Success'.
whenInvalid :: a -> Bool -> T.Text -> V.Validation [T.Text] a
whenInvalid x invalid err =
  if invalid then
    V.Failure [err]
  else
    V.Success x