module Irc.Identifier
( Identifier
, idDenote
, mkId
, idText
, idTextNorm
, idPrefix
) where
import Control.Monad.ST
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Char
import Data.Foldable
import Data.Hashable
import Data.String
import Data.Text (Text)
import qualified Data.Text.Encoding as Text
import qualified Data.Vector.Primitive as PV
import qualified Data.Primitive.ByteArray as BA
import Data.Primitive.ByteArray (ByteArray)
import Data.Word
data Identifier = Identifier {-# UNPACK #-} !Text
{-# UNPACK #-} !ByteArray
indexWord8 :: ByteArray -> Int -> Word8
indexWord8 :: ByteArray -> Int -> Word8
indexWord8 = forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray
instance Eq Identifier where
Identifier Text
_ ByteArray
x == :: Identifier -> Identifier -> Bool
== Identifier Text
_ ByteArray
y =
ByteArray -> Int
BA.sizeofByteArray ByteArray
x forall a. Eq a => a -> a -> Bool
== ByteArray -> Int
BA.sizeofByteArray ByteArray
y Bool -> Bool -> Bool
&&
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
i -> ByteArray -> Int -> Word8
indexWord8 ByteArray
x Int
i forall a. Eq a => a -> a -> Bool
== ByteArray -> Int -> Word8
indexWord8 ByteArray
y Int
i)
[Int
0 .. ByteArray -> Int
BA.sizeofByteArray ByteArray
x forall a. Num a => a -> a -> a
- Int
1]
instance Show Identifier where
show :: Identifier -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Text
idText
instance Read Identifier where
readsPrec :: Int -> ReadS Identifier
readsPrec Int
p String
x = [ (Text -> Identifier
mkId Text
t, String
rest) | (Text
t,String
rest) <- forall a. Read a => Int -> ReadS a
readsPrec Int
p String
x]
instance Ord Identifier where
compare :: Identifier -> Identifier -> Ordering
compare (Identifier Text
_ ByteArray
x) (Identifier Text
_ ByteArray
y) =
forall a. Monoid a => [a] -> a
mconcat [ ByteArray -> Int -> Word8
indexWord8 ByteArray
x Int
i forall a. Ord a => a -> a -> Ordering
`compare` ByteArray -> Int -> Word8
indexWord8 ByteArray
y Int
i | Int
i <- [Int
0..Int
nforall a. Num a => a -> a -> a
-Int
1]]
forall a. Semigroup a => a -> a -> a
<> (ByteArray -> Int
BA.sizeofByteArray ByteArray
x forall a. Ord a => a -> a -> Ordering
`compare` ByteArray -> Int
BA.sizeofByteArray ByteArray
y)
where
n :: Int
n = forall a. Ord a => a -> a -> a
min (ByteArray -> Int
BA.sizeofByteArray ByteArray
x) (ByteArray -> Int
BA.sizeofByteArray ByteArray
y)
instance Hashable Identifier where
hashWithSalt :: Int -> Identifier -> Int
hashWithSalt Int
salt (Identifier Text
_ b :: ByteArray
b@(BA.ByteArray ByteArray#
arr)) =
ByteArray# -> Int -> Int -> Int -> Int
hashByteArrayWithSalt ByteArray#
arr Int
0 (ByteArray -> Int
BA.sizeofByteArray ByteArray
b) Int
salt
instance IsString Identifier where
fromString :: String -> Identifier
fromString = Text -> Identifier
mkId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
mkId :: Text -> Identifier
mkId :: Text -> Identifier
mkId Text
x = Text -> ByteArray -> Identifier
Identifier Text
x (ByteString -> ByteArray
ircFoldCase (Text -> ByteString
Text.encodeUtf8 Text
x))
idText :: Identifier -> Text
idText :: Identifier -> Text
idText (Identifier Text
x ByteArray
_) = Text
x
idDenote :: Identifier -> ByteArray
idDenote :: Identifier -> ByteArray
idDenote (Identifier Text
_ ByteArray
x) = ByteArray
x
idTextNorm :: Identifier -> Text
idTextNorm :: Identifier -> Text
idTextNorm (Identifier Text
_ ByteArray
x) =
ByteString -> Text
Text.decodeUtf8
([Word8] -> ByteString
B.pack [ ByteArray -> Int -> Word8
indexWord8 ByteArray
x Int
i | Int
i <- [Int
0 .. ByteArray -> Int
BA.sizeofByteArray ByteArray
x forall a. Num a => a -> a -> a
- Int
1]])
idPrefix :: Identifier -> Identifier -> Bool
idPrefix :: Identifier -> Identifier -> Bool
idPrefix (Identifier Text
_ ByteArray
x) (Identifier Text
_ ByteArray
y) =
ByteArray -> Int
BA.sizeofByteArray ByteArray
x forall a. Ord a => a -> a -> Bool
<= ByteArray -> Int
BA.sizeofByteArray ByteArray
y Bool -> Bool -> Bool
&&
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
i -> ByteArray -> Int -> Word8
indexWord8 ByteArray
x Int
i forall a. Eq a => a -> a -> Bool
== ByteArray -> Int -> Word8
indexWord8 ByteArray
y Int
i)
[Int
0 .. ByteArray -> Int
BA.sizeofByteArray ByteArray
x forall a. Num a => a -> a -> a
- Int
1]
ircFoldCase :: ByteString -> ByteArray
ircFoldCase :: ByteString -> ByteArray
ircFoldCase ByteString
bs = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$
do let n :: Int
n = ByteString -> Int
B.length ByteString
bs
MutableByteArray s
a <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
BA.newByteArray Int
n
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0..Int
nforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i ->
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
a Int
i (Vector Word8
casemap forall a. Prim a => Vector a -> Int -> a
PV.! forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
B.index ByteString
bs Int
i))
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
BA.unsafeFreezeByteArray MutableByteArray s
a
casemap :: PV.Vector Word8
casemap :: Vector Word8
casemap
= forall a. Prim a => [a] -> Vector a
PV.fromList
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)
forall a b. (a -> b) -> a -> b
$ [Char
'\x00'..Char
'`'] forall a. [a] -> [a] -> [a]
++ String
"ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^" forall a. [a] -> [a] -> [a]
++ [Char
'\x7f'..Char
'\xff']