{-# LANGUAGE TypeFamilies, FlexibleInstances, GeneralizedNewtypeDeriving #-}
module Data.Interned.Internal.ByteString
  ( InternedByteString(..)
  ) where

import Data.String
import Data.Interned
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as Char8
import Data.Hashable

data InternedByteString = InternedByteString
  { InternedByteString -> Id
internedByteStringId :: {-# UNPACK #-} !Id
  , InternedByteString -> ByteString
uninternByteString   :: {-# UNPACK #-} !ByteString
  }

instance IsString InternedByteString where
  fromString :: String -> InternedByteString
fromString = forall t. Interned t => Uninterned t -> t
intern forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
Char8.pack

instance Eq InternedByteString where
  InternedByteString Id
i ByteString
_ == :: InternedByteString -> InternedByteString -> Bool
== InternedByteString Id
j ByteString
_ = Id
i forall a. Eq a => a -> a -> Bool
== Id
j

instance Ord InternedByteString where
  InternedByteString Id
i ByteString
_ compare :: InternedByteString -> InternedByteString -> Ordering
`compare` InternedByteString Id
j ByteString
_ = Id
i forall a. Ord a => a -> a -> Ordering
`compare` Id
j

instance Show InternedByteString where
  showsPrec :: Id -> InternedByteString -> ShowS
showsPrec Id
d (InternedByteString Id
_ ByteString
b) = forall a. Show a => Id -> a -> ShowS
showsPrec Id
d ByteString
b

instance Hashable InternedByteString where
  hashWithSalt :: Id -> InternedByteString -> Id
hashWithSalt Id
s (InternedByteString Id
i ByteString
_) = forall a. Hashable a => Id -> a -> Id
hashWithSalt Id
s Id
i

instance Interned InternedByteString where
  type Uninterned InternedByteString = ByteString
  newtype Description InternedByteString = DBS ByteString deriving (Description InternedByteString
-> Description InternedByteString -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Description InternedByteString
-> Description InternedByteString -> Bool
$c/= :: Description InternedByteString
-> Description InternedByteString -> Bool
== :: Description InternedByteString
-> Description InternedByteString -> Bool
$c== :: Description InternedByteString
-> Description InternedByteString -> Bool
Eq,Eq (Description InternedByteString)
Id -> Description InternedByteString -> Id
Description InternedByteString -> Id
forall a. Eq a -> (Id -> a -> Id) -> (a -> Id) -> Hashable a
hash :: Description InternedByteString -> Id
$chash :: Description InternedByteString -> Id
hashWithSalt :: Id -> Description InternedByteString -> Id
$chashWithSalt :: Id -> Description InternedByteString -> Id
Hashable)
  describe :: Uninterned InternedByteString -> Description InternedByteString
describe = ByteString -> Description InternedByteString
DBS
  identify :: Id -> Uninterned InternedByteString -> InternedByteString
identify = Id -> ByteString -> InternedByteString
InternedByteString
  cache :: Cache InternedByteString
cache = Cache InternedByteString
ibsCache

instance Uninternable InternedByteString where
  unintern :: InternedByteString -> Uninterned InternedByteString
unintern = InternedByteString -> ByteString
uninternByteString

ibsCache :: Cache InternedByteString
ibsCache :: Cache InternedByteString
ibsCache = forall t. Interned t => Cache t
mkCache
{-# NOINLINE ibsCache #-}