module Irc.Identifier
( Identifier
, idDenote
, mkId
, idText
, idPrefix
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Char
import Data.Function
import Data.Hashable
import Data.Primitive.ByteArray
import Data.String
import Data.Text (Text)
import qualified Data.Text.Encoding as Text
import qualified Data.Vector.Primitive as PV
import Data.Word
data Identifier = Identifier {-# UNPACK #-} !Text
{-# UNPACK #-} !(PV.Vector Word8)
instance Eq Identifier where
(==) = (==) `on` idDenote
instance Show Identifier where
show = show . idText
instance Read Identifier where
readsPrec p x = [ (mkId t, rest) | (t,rest) <- readsPrec p x]
instance Ord Identifier where
compare = compare `on` idDenote
instance Hashable Identifier where
hashWithSalt s = hashPV8WithSalt s . idDenote
instance IsString Identifier where
fromString = mkId . fromString
hashPV8WithSalt :: Int -> PV.Vector Word8 -> Int
hashPV8WithSalt salt (PV.Vector off len (ByteArray arr)) =
hashByteArrayWithSalt arr off len salt
mkId :: Text -> Identifier
mkId x = Identifier x (ircFoldCase (Text.encodeUtf8 x))
idText :: Identifier -> Text
idText (Identifier x _) = x
idDenote :: Identifier -> PV.Vector Word8
idDenote (Identifier _ x) = x
idPrefix :: Identifier -> Identifier -> Bool
idPrefix (Identifier _ x) (Identifier _ y) = x == PV.take (PV.length x) y
ircFoldCase :: ByteString -> PV.Vector Word8
ircFoldCase = PV.fromList . map (\i -> casemap PV.! fromIntegral i) . B.unpack
casemap :: PV.Vector Word8
casemap
= PV.fromList
$ map (fromIntegral . ord)
$ ['\x00'..'`'] ++ "ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^" ++ ['\x7f'..'\xff']