{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Convenience wrappers and utilities for byte strings.
module Zenacy.HTML.Internal.BS
  ( BS
  -- * Word functions.
  , bsEmpty
  , bsOnly
  , bsLen
  , bsPack
  , bsUnpack
  , bsConcat
  , bsIndex
  , bsElemIndex
  , bsLower
  , bsPrefixCI
  , bsPart
  , bsLast
  , bsTake
  , bsDrop
  , bsUncons
  -- * Character functions.
  , bcPack
  , bcUnpack
  ) where

import Zenacy.HTML.Internal.Char
import Data.ByteString
  ( ByteString
  )
import qualified Data.ByteString as S
  ( concat
  , drop
  , elemIndex
  , empty
  , isPrefixOf
  , index
  , last
  , length
  , map
  , pack
  , singleton
  , take
  , uncons
  , unpack
  )
import qualified Data.ByteString.Char8 as C
  ( pack
  , unpack
  )
import Data.Word
  ( Word8
  )

-- | A type abbreviation for a byte string.
type BS = ByteString

-- | An empty byte string.
bsEmpty :: BS
bsEmpty :: BS
bsEmpty = BS
S.empty
{-# INLINE bsEmpty #-}

-- | A byte string with only one character.
bsOnly :: Word8 -> BS
bsOnly :: Word8 -> BS
bsOnly = Word8 -> BS
S.singleton
{-# INLINE bsOnly #-}

-- | Gets the length of a byte string.
bsLen :: BS -> Int
bsLen :: BS -> Int
bsLen = BS -> Int
S.length
{-# INLINE bsLen #-}

-- | Converts a list of characters to a byte string.
bsPack :: [Word8] -> BS
bsPack :: [Word8] -> BS
bsPack = [Word8] -> BS
S.pack
{-# INLINE bsPack #-}

-- | Converts a byte string to a list of characters.
bsUnpack :: BS -> [Word8]
bsUnpack :: BS -> [Word8]
bsUnpack = BS -> [Word8]
S.unpack
{-# INLINE bsUnpack #-}

-- | Concatenates byte strings into one.
bsConcat :: [BS] -> BS
bsConcat :: [BS] -> BS
bsConcat = [BS] -> BS
S.concat
{-# INLINE bsConcat #-}

-- | Gets the character at an index in a byte string.
bsIndex :: BS -> Int -> Word8
bsIndex :: BS -> Int -> Word8
bsIndex = HasCallStack => BS -> Int -> Word8
S.index
{-# INLINE bsIndex #-}

-- | Gets the index of a character in a byte string.
bsElemIndex :: Word8 -> BS -> Maybe Int
bsElemIndex :: Word8 -> BS -> Maybe Int
bsElemIndex = Word8 -> BS -> Maybe Int
S.elemIndex
{-# INLINE bsElemIndex #-}

-- | Converts a bytestring to lowercase.
bsLower :: BS -> BS
bsLower :: BS -> BS
bsLower = (Word8 -> Word8) -> BS -> BS
S.map Word8 -> Word8
chrToLower

-- | Determines if a bytestring is a case-insensitive prefix of another.
bsPrefixCI :: BS -> BS -> Bool
bsPrefixCI :: BS -> BS -> Bool
bsPrefixCI BS
x BS
y = BS -> BS
bsLower BS
x BS -> BS -> Bool
`S.isPrefixOf` BS -> BS
bsLower BS
y

-- | Selects a substring for a byte string.
bsPart :: Int -> Int -> BS -> BS
bsPart :: Int -> Int -> BS -> BS
bsPart Int
offset Int
len = Int -> BS -> BS
S.take Int
len forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BS -> BS
S.drop Int
offset

-- | Returns the last word of a bytestring.
bsLast :: BS -> Maybe Word8
bsLast :: BS -> Maybe Word8
bsLast BS
x
  | BS -> Int
bsLen BS
x forall a. Ord a => a -> a -> Bool
> Int
0 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ HasCallStack => BS -> Word8
S.last BS
x
  | Bool
otherwise = forall a. Maybe a
Nothing

-- | Takes characters from a byte string.
bsTake :: Int -> BS -> BS
bsTake :: Int -> BS -> BS
bsTake = Int -> BS -> BS
S.take
{-# INLINE bsTake #-}

-- | Drops characters from a byte string.
bsDrop :: Int -> BS -> BS
bsDrop :: Int -> BS -> BS
bsDrop = Int -> BS -> BS
S.drop
{-# INLINE bsDrop #-}

-- | Removes a character from the end of a byte string.
bsUncons :: BS -> Maybe (Word8, BS)
bsUncons :: BS -> Maybe (Word8, BS)
bsUncons = BS -> Maybe (Word8, BS)
S.uncons
{-# INLINE bsUncons #-}

-- | Converts a string to a byte string.
bcPack :: String -> BS
bcPack :: String -> BS
bcPack = String -> BS
C.pack
{-# INLINE bcPack #-}

-- | Converts a bytestring to a string.
bcUnpack :: BS -> String
bcUnpack :: BS -> String
bcUnpack = BS -> String
C.unpack
{-# INLINE bcUnpack #-}