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

    import Data.String
    import Data.Interned
    import Data.Hashable
    import Data.Foldable

    data InternedString = IS
      { InternedString -> Id
    internedStringId :: {-# UNPACK #-} !Id
      , InternedString -> String
    uninternString :: String
      }

    instance IsString InternedString where
      fromString :: String -> InternedString
    fromString = String -> InternedString
    Uninterned InternedString -> InternedString
    forall t. Interned t => Uninterned t -> t
    intern

    instance Eq InternedString where
      IS Id
    i String
    _ == :: InternedString -> InternedString -> Bool
    == IS Id
    j String
    _ = Id
    i Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id
    j

    instance Ord InternedString where
      compare :: InternedString -> InternedString -> Ordering
    compare (IS Id
    i String
    _) (IS Id
    j String
    _) = Id -> Id -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Id
    i Id
    j

    instance Show InternedString where
      showsPrec :: Id -> InternedString -> ShowS
    showsPrec Id
    d (IS Id
    _ String
    b) = Id -> String -> ShowS
    forall a. Show a => Id -> a -> ShowS
    showsPrec Id
    d String
    b

    instance Hashable InternedString where
      hashWithSalt :: Id -> InternedString -> Id
    hashWithSalt Id
    s (IS Id
    i String
    _) = Id -> Id -> Id
    forall a. Hashable a => Id -> a -> Id
    hashWithSalt Id
    s Id
    i

    instance Interned InternedString where
      type Uninterned InternedString = String
      data Description InternedString = Cons {-# UNPACK #-} !Char String | Nil
        deriving (Description InternedString -> Description InternedString -> Bool
    (Description InternedString -> Description InternedString -> Bool)
    -> (Description InternedString
        -> Description InternedString -> Bool)
    -> Eq (Description InternedString)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Description InternedString -> Description InternedString -> Bool
    == :: Description InternedString -> Description InternedString -> Bool
    $c/= :: Description InternedString -> Description InternedString -> Bool
    /= :: Description InternedString -> Description InternedString -> Bool
    Eq)
      describe :: Uninterned InternedString -> Description InternedString
    describe (Char
    c:String
    cs) = Char -> String -> Description InternedString
    Cons Char
    c String
    cs
      describe []     = Description InternedString
    Nil
      identify :: Id -> Uninterned InternedString -> InternedString
    identify = Id -> String -> InternedString
    Id -> Uninterned InternedString -> InternedString
    IS
      cache :: Cache InternedString
    cache = Cache InternedString
    stringCache

    instance Uninternable InternedString where
      unintern :: InternedString -> Uninterned InternedString
    unintern = InternedString -> String
    InternedString -> Uninterned InternedString
    uninternString

    instance Hashable (Description InternedString) where
      hashWithSalt :: Id -> Description InternedString -> Id
    hashWithSalt Id
    s (Cons Char
    c String
    cs) = (Id -> Char -> Id) -> Id -> String -> Id
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Id -> Char -> Id
    forall a. Hashable a => Id -> a -> Id
    hashWithSalt (Id -> Char -> Id
    forall a. Hashable a => Id -> a -> Id
    hashWithSalt Id
    s Char
    c) String
    cs
      hashWithSalt Id
    s Description InternedString
    R:DescriptionInternedString
    Nil         = Id
    s Id -> Id -> Id
    forall a. Hashable a => Id -> a -> Id
    `hashWithSalt` (Id
    0 :: Int)

    stringCache :: Cache InternedString
    stringCache :: Cache InternedString
    stringCache = Cache InternedString
    forall t. Interned t => Cache t
    mkCache
    {-# NOINLINE stringCache #-}