{-# LANGUAGE DeriveLift #-}
module Data.BitSetWord8.Internal where
import Data.Bits (setBit, shiftR, testBit)
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 (Word64, Word8)
import Language.Haskell.TH.Syntax (Lift)
data BitSetWord8 = BitSetWord8 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
{-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
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 bitSet val = doMember bitSet (val `div` 64) (val `mod` 64)
where
doMember :: BitSetWord8 -> Word8 -> Word8 -> Bool
doMember (BitSetWord8 w _ _ _) 0 ind = testBit w (fromIntegral ind)
doMember (BitSetWord8 _ w _ _) 1 ind = testBit w (fromIntegral ind)
doMember (BitSetWord8 _ _ w _) 2 ind = testBit w (fromIntegral ind)
doMember (BitSetWord8 _ _ _ w) 3 ind = testBit w (fromIntegral ind)
doMember _ _ _ = error "Impossible happen. Word8 `dev` 64 cannot be greater than 3."
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]
toWord64 :: [Bool] -> Word64
toWord64 = foldl' (\a e -> let aL = shiftR a 1 in if e == True then setBit aL 63 else aL) 0
toWord64List :: [Bool] -> [Word64]
toWord64List [] = []
toWord64List bs = let (bs64, rest) = splitAt 64 bs in toWord64 bs64 : toWord64List rest
fromList :: [Char] -> BitSetWord8
fromList = fromWord64List . toWord64List . toBoolList . toWord8Set
where
fromWord64List :: [Word64] -> BitSetWord8
fromWord64List (w0:w1:w2:w3:_) = BitSetWord8 w0 w1 w2 w3
fromWord64List [_, _, _] = raiseError
fromWord64List [_, _] = raiseError
fromWord64List [_] = raiseError
fromWord64List [] = raiseError
raiseError = error "Impossible happen. Arg of fromList must be converted to 4 elements list."