{-# LANGUAGE TypeFamilies, FlexibleInstances #-}
module Data.Interned.Internal.Text
  ( InternedText(..)
  ) where

import Data.String
import Data.Interned
import qualified Data.Text as T
import Data.Text (Text)
import Data.Hashable

data InternedText = InternedText
  { InternedText -> Id
internedTextId :: {-# UNPACK #-} !Id
  , InternedText -> Text
uninternedText :: {-# UNPACK #-} !Text
  }

instance IsString InternedText where
  fromString :: String -> InternedText
fromString = forall t. Interned t => Uninterned t -> t
intern forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance Eq InternedText where
  InternedText Id
i Text
_ == :: InternedText -> InternedText -> Bool
== InternedText Id
j Text
_ = Id
i forall a. Eq a => a -> a -> Bool
== Id
j

instance Ord InternedText where
  compare :: InternedText -> InternedText -> Ordering
compare (InternedText Id
i Text
_) (InternedText Id
j Text
_) = forall a. Ord a => a -> a -> Ordering
compare Id
i Id
j

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

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

instance Interned InternedText where
  type Uninterned InternedText = Text
  newtype Description InternedText = DT Text deriving (Description InternedText -> Description InternedText -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Description InternedText -> Description InternedText -> Bool
$c/= :: Description InternedText -> Description InternedText -> Bool
== :: Description InternedText -> Description InternedText -> Bool
$c== :: Description InternedText -> Description InternedText -> Bool
Eq)
  describe :: Uninterned InternedText -> Description InternedText
describe = Text -> Description InternedText
DT
  identify :: Id -> Uninterned InternedText -> InternedText
identify = Id -> Text -> InternedText
InternedText
  cache :: Cache InternedText
cache = Cache InternedText
itCache

instance Uninternable InternedText where
  unintern :: InternedText -> Uninterned InternedText
unintern (InternedText Id
_ Text
b) = Text
b

instance Hashable (Description InternedText) where
  hashWithSalt :: Id -> Description InternedText -> Id
hashWithSalt Id
s (DT Text
h) = forall a. Hashable a => Id -> a -> Id
hashWithSalt Id
s Text
h

itCache :: Cache InternedText
itCache :: Cache InternedText
itCache = forall t. Interned t => Cache t
mkCache
{-# NOINLINE itCache #-}