module Distribution.Utils.ShortText
(
ShortText
, toShortText
, fromShortText
, unsafeFromUTF8BS
, null
, length
, decodeStringUtf8
, encodeStringUtf8
) where
import Distribution.Compat.Prelude hiding (length, null)
import Prelude ()
import Distribution.Utils.String (decodeStringUtf8, encodeStringUtf8)
import Distribution.Utils.Structured (Structured (..), nominalStructure)
#if defined(MIN_VERSION_bytestring)
# if MIN_VERSION_bytestring(0,10,4)
# define HAVE_SHORTBYTESTRING 1
# endif
#endif
#ifndef MIN_VERSION_binary
#define MIN_VERSION_binary(x, y, z) 0
#endif
import qualified Data.ByteString as BS
import qualified Data.List as List
#if HAVE_SHORTBYTESTRING
import qualified Data.ByteString.Short as BS.Short
#else
import Distribution.Utils.Generic (fromUTF8BS)
#endif
toShortText :: String -> ShortText
fromShortText :: ShortText -> String
unsafeFromUTF8BS :: BS.ByteString -> ShortText
null :: ShortText -> Bool
#if HAVE_SHORTBYTESTRING
newtype ShortText = ST { unST :: BS.Short.ShortByteString }
deriving (Eq,Ord,Generic,Data,Typeable)
# if MIN_VERSION_binary(0,8,1)
instance Binary ShortText where
put = put . unST
get = fmap ST get
# else
instance Binary ShortText where
put = put . BS.Short.fromShort . unST
get = fmap (ST . BS.Short.toShort) get
# endif
toShortText = ST . BS.Short.pack . encodeStringUtf8
fromShortText = decodeStringUtf8 . BS.Short.unpack . unST
unsafeFromUTF8BS = ST . BS.Short.toShort
null = BS.Short.null . unST
#else
newtype ShortText = ST { unST :: String }
deriving (Eq,Ord,Generic,Data,Typeable)
instance Binary ShortText where
put = put . encodeStringUtf8 . unST
get = fmap (ST . decodeStringUtf8) get
toShortText = ST
fromShortText = unST
unsafeFromUTF8BS = ST . fromUTF8BS
null = List.null . unST
#endif
instance Structured ShortText where structure = nominalStructure
instance NFData ShortText where
rnf = rnf . unST
instance Show ShortText where
show = show . fromShortText
instance Read ShortText where
readsPrec p = map (first toShortText) . readsPrec p
instance Semigroup ShortText where
ST a <> ST b = ST (mappend a b)
instance Monoid ShortText where
mempty = ST mempty
mappend = (<>)
instance IsString ShortText where
fromString = toShortText
length :: ShortText -> Int
length = List.length . fromShortText