module Data.BitSetWord8.Internal where
import Prelude hiding (zipWith)
import Data.Bits (setBit, shiftR, testBit)
import Data.ByteString (ByteString, index, pack, zipWith)
import Data.Char (chr, ord)
import Data.List (foldl', splitAt)
import Data.Semigroup ((<>))
import qualified Data.Set as Set (Set, fromList, member)
import Data.Word (Word8)
import Instances.TH.Lift
import Language.Haskell.TH.Syntax (Lift)
newtype BitSetWord8 = BitSetWord8 ByteString deriving (Eq, Lift, Show)
rfc5234Digit' :: [Char]
rfc5234Digit' = ['0'..'9']
rfc2616UpAlpha' :: [Char]
rfc2616UpAlpha' = [ 'A'..'Z' ]
rfc2616LoAlpha' :: [Char]
rfc2616LoAlpha' = [ 'a'..'z' ]
rfc5234Alpha' :: [Char]
rfc5234Alpha' = rfc2616UpAlpha' <> rfc2616LoAlpha'
rfc5234HexDig' :: [Char]
rfc5234HexDig' = rfc5234Digit' <> ['A'..'F']
rfc5234VChar' :: [Char]
rfc5234VChar' = [ '!'..'~']
rfc5324Wsp' :: [Char]
rfc5324Wsp' = [ '\t', ' ' ]
rfc3986SubDelims' :: [Char]
rfc3986SubDelims' = [ '!', '$', '&', '\'', '(', ')', '*', '+', ',', ';', '=' ]
rfc3986GenDelims' :: [Char]
rfc3986GenDelims' = [ ':', '/', '?', '#', '[', ']', '@']
rfc3986Reserved' :: [Char]
rfc3986Reserved' = rfc3986GenDelims' <> rfc3986SubDelims'
rfc3986Unreserved' :: [Char]
rfc3986Unreserved' = rfc5234Alpha' <> rfc5234Digit' <> [ '-', '.', '_', '~' ]
rfc3986PctEncodedChar' :: [Char]
rfc3986PctEncodedChar' = ['%'] <> rfc5234HexDig'
rfc3986PChar' :: [Char]
rfc3986PChar' = rfc3986Unreserved' <> rfc3986PctEncodedChar' <> rfc3986SubDelims' <> [':', '@']
rfc3986UriReference' :: [Char]
rfc3986UriReference' = rfc3986Reserved' <> rfc3986Unreserved' <> ['%']
rfc7230TChar' :: [Char]
rfc7230TChar' = [ '!', '#', '$', '%', '&', '\'', '*', '+', '-', '.', '^', '_', '`', '|', '~' ]
<> rfc5234Digit' <> rfc5234Alpha'
rfc7230ObsText' :: [Char]
rfc7230ObsText' = [ chr 0x80 .. chr 0xff]
rfc7230QDText' :: [Char]
rfc7230QDText' = rfc5324Wsp' <> [ '!' ] <> [ '#' .. '[' ] <> [ ']' .. '~'] <> rfc7230ObsText'
rfc7230QuotedPair' :: [Char]
rfc7230QuotedPair' = rfc5324Wsp' <> rfc5234VChar' <> rfc7230ObsText'
member :: BitSetWord8 -> Word8 -> Bool
member (BitSetWord8 bs) w = testBit (index bs (fromIntegral (w `div` 8))) (fromIntegral (w `mod` 8))
toWord8Set :: [Char] -> Set.Set Word8
toWord8Set = Set.fromList . map fromIntegral . filter (<= fromIntegral (maxBound :: Word8)) . map ord
toBoolList :: Set.Set Word8 -> [Bool]
toBoolList wSet = map (\w -> Set.member w wSet) [0..0xff]
toWord8 :: [Bool] -> Word8
toWord8 = foldl' (\a e -> let aL = shiftR a 1 in if e == True then setBit aL 7 else aL) 0
toWord8List :: [Bool] -> [Word8]
toWord8List [] = []
toWord8List bs = let (bs8, rest) = splitAt 8 bs in toWord8 bs8 : toWord8List rest
fromList :: [Char] -> BitSetWord8
fromList = BitSetWord8 . pack . toWord8List . toBoolList . toWord8Set