-- | An implementation of @Int@-mapped @Text@s with internalization. Wrap
-- a @Text@ with 'bti' to receive a @BTI@. This internalizes the given
-- @Text@, meaning that two text inputs @x@ and @y@ will yield the same
-- @BTI@ if they have the same textual representation.
--
-- Since internalized @Text@ values are never released, be sure to use it
-- sparingly. I.e. to internalize words, not full sentences.
module NLP.Text.BTI
( module NLP.Text.BTI
) where
import Control.Applicative
import Control.DeepSeq (NFData(..))
import Data.Aeson as A
import Data.Binary as DB
import Data.ByteString (ByteString)
import Data.Hashable
import Data.Serialize as DS
import Data.Serialize.Text
import Data.String as IS
import Data.String.Conversions
import Data.Text.Binary
import Data.Text.Encoding (decodeUtf8,encodeUtf8)
import Data.Text (Text)
import Data.Vector.Unboxed.Deriving
import GHC.Generics
import NLP.Text.BTI.Internal
-- | A @BTI@ behaves much like a @Text@, but is represented as an @Int@
-- internally.
newtype BTI = BTI { getBTI :: Int }
deriving (Eq,Generic)
derivingUnbox "BTI"
[t| BTI -> Int |]
[| getBTI |]
[| BTI |]
instance Ord BTI where
BTI l `compare` BTI r = btiBimapLookupInt l `compare` btiBimapLookupInt r
{-# Inline compare #-}
-- | Handy wrapper to internalize a @Text@ and get a 'BTI'.
bti :: Text -> BTI
bti s = BTI $! btiBimapAdd $ encodeUtf8 s
{-# Inline bti #-}
instance IsString BTI where
fromString = bti . IS.fromString
{-# Inline fromString #-}
instance Show BTI where
showsPrec p i r = showsPrec p (btiToCS i :: String) r
{-# Inline showsPrec #-}
instance Read BTI where
readsPrec p str = [ (bti $ IS.fromString s, y) | (s,y) <- readsPrec p str ]
{-# Inline readsPrec #-}
instance Hashable BTI
btiFromCS :: ConvertibleStrings x Text => x -> BTI
btiFromCS = bti . convertString
btiToCS :: ConvertibleStrings Text x => BTI -> x
btiToCS = convertString . btiToText
btiToText :: BTI -> Text
btiToText = decodeUtf8 . btiToUtf8
btiToUtf8 :: BTI -> ByteString
btiToUtf8 = btiBimapLookupInt . getBTI
instance NFData BTI where
rnf = rnf . getBTI
{-# Inline rnf #-}
instance Binary BTI where
put = DB.put . btiToText
get = bti <$> DB.get
{-# Inline put #-}
{-# Inline get #-}
instance Serialize BTI where
put = DS.put . btiToText
get = bti <$> DS.get
{-# Inline put #-}
{-# Inline get #-}
instance FromJSON BTI where
parseJSON s = bti <$> parseJSON s
{-# Inline parseJSON #-}
instance ToJSON BTI where
toJSON = toJSON . btiToText
{-# Inline toJSON #-}