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 = ByteArray -> Int -> Word8
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteArray -> Int
BA.sizeofByteArray ByteArray
y Bool -> Bool -> Bool
&&
(Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
i -> ByteArray -> Int -> Word8
indexWord8 ByteArray
x Int
i Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== ByteArray -> Int -> Word8
indexWord8 ByteArray
y Int
i)
[Int
0 .. ByteArray -> Int
BA.sizeofByteArray ByteArray
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
instance Show Identifier where
show :: Identifier -> String
show = Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (Identifier -> Text) -> Identifier -> String
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) <- Int -> ReadS Text
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) =
[Ordering] -> Ordering
forall a. Monoid a => [a] -> a
mconcat [ ByteArray -> Int -> Word8
indexWord8 ByteArray
x Int
i Word8 -> Word8 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ByteArray -> Int -> Word8
indexWord8 ByteArray
y Int
i | Int
i <- [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (ByteArray -> Int
BA.sizeofByteArray ByteArray
x Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ByteArray -> Int
BA.sizeofByteArray ByteArray
y)
where
n :: Int
n = Int -> Int -> Int
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 (Text -> Identifier) -> (String -> Text) -> String -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
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 Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteArray -> Int
BA.sizeofByteArray ByteArray
y Bool -> Bool -> Bool
&&
(Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
i -> ByteArray -> Int -> Word8
indexWord8 ByteArray
x Int
i Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== ByteArray -> Int -> Word8
indexWord8 ByteArray
y Int
i)
[Int
0 .. ByteArray -> Int
BA.sizeofByteArray ByteArray
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
ircFoldCase :: ByteString -> ByteArray
ircFoldCase :: ByteString -> ByteArray
ircFoldCase ByteString
bs = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$
do let n :: Int
n = ByteString -> Int
B.length ByteString
bs
MutableByteArray s
a <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
BA.newByteArray Int
n
[Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
i ->
MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
a Int
i (Vector Word8
casemap Vector Word8 -> Int -> Word8
forall a. Prim a => Vector a -> Int -> a
PV.! Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
B.index ByteString
bs Int
i))
MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
BA.unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
a
casemap :: PV.Vector Word8
casemap :: Vector Word8
casemap
= [Word8] -> Vector Word8
forall a. Prim a => [a] -> Vector a
PV.fromList
([Word8] -> Vector Word8) -> [Word8] -> Vector Word8
forall a b. (a -> b) -> a -> b
$ (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)
(String -> [Word8]) -> String -> [Word8]
forall a b. (a -> b) -> a -> b
$ [Char
'\x00'..Char
'`'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'\x7f'..Char
'\xff']