{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, GeneralizedNewtypeDeriving, DerivingStrategies, CPP #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
#if GHC_STAGE < 1
{-# OPTIONS_GHC -fignore-interface-pragmas #-}
#endif
module GHC.Data.ShortText (
ShortText(..),
pack,
unpack,
codepointLength,
byteLength,
GHC.Data.ShortText.null,
splitFilePath,
GHC.Data.ShortText.head,
stripPrefix
) where
import Prelude
import Control.Monad (guard)
import Control.DeepSeq as DeepSeq
import Data.Binary
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Short.Internal as SBS
import GHC.Exts
import GHC.IO
import GHC.Utils.Encoding
import System.FilePath (isPathSeparator)
newtype ShortText = ShortText { ShortText -> ShortByteString
contents :: SBS.ShortByteString
}
deriving stock (Int -> ShortText -> ShowS
[ShortText] -> ShowS
ShortText -> String
(Int -> ShortText -> ShowS)
-> (ShortText -> String)
-> ([ShortText] -> ShowS)
-> Show ShortText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShortText] -> ShowS
$cshowList :: [ShortText] -> ShowS
show :: ShortText -> String
$cshow :: ShortText -> String
showsPrec :: Int -> ShortText -> ShowS
$cshowsPrec :: Int -> ShortText -> ShowS
Show)
deriving newtype (ShortText -> ShortText -> Bool
(ShortText -> ShortText -> Bool)
-> (ShortText -> ShortText -> Bool) -> Eq ShortText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShortText -> ShortText -> Bool
$c/= :: ShortText -> ShortText -> Bool
== :: ShortText -> ShortText -> Bool
$c== :: ShortText -> ShortText -> Bool
Eq, Eq ShortText
Eq ShortText
-> (ShortText -> ShortText -> Ordering)
-> (ShortText -> ShortText -> Bool)
-> (ShortText -> ShortText -> Bool)
-> (ShortText -> ShortText -> Bool)
-> (ShortText -> ShortText -> Bool)
-> (ShortText -> ShortText -> ShortText)
-> (ShortText -> ShortText -> ShortText)
-> Ord ShortText
ShortText -> ShortText -> Bool
ShortText -> ShortText -> Ordering
ShortText -> ShortText -> ShortText
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ShortText -> ShortText -> ShortText
$cmin :: ShortText -> ShortText -> ShortText
max :: ShortText -> ShortText -> ShortText
$cmax :: ShortText -> ShortText -> ShortText
>= :: ShortText -> ShortText -> Bool
$c>= :: ShortText -> ShortText -> Bool
> :: ShortText -> ShortText -> Bool
$c> :: ShortText -> ShortText -> Bool
<= :: ShortText -> ShortText -> Bool
$c<= :: ShortText -> ShortText -> Bool
< :: ShortText -> ShortText -> Bool
$c< :: ShortText -> ShortText -> Bool
compare :: ShortText -> ShortText -> Ordering
$ccompare :: ShortText -> ShortText -> Ordering
Ord, Get ShortText
[ShortText] -> Put
ShortText -> Put
(ShortText -> Put)
-> Get ShortText -> ([ShortText] -> Put) -> Binary ShortText
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ShortText] -> Put
$cputList :: [ShortText] -> Put
get :: Get ShortText
$cget :: Get ShortText
put :: ShortText -> Put
$cput :: ShortText -> Put
Binary, NonEmpty ShortText -> ShortText
ShortText -> ShortText -> ShortText
(ShortText -> ShortText -> ShortText)
-> (NonEmpty ShortText -> ShortText)
-> (forall b. Integral b => b -> ShortText -> ShortText)
-> Semigroup ShortText
forall b. Integral b => b -> ShortText -> ShortText
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> ShortText -> ShortText
$cstimes :: forall b. Integral b => b -> ShortText -> ShortText
sconcat :: NonEmpty ShortText -> ShortText
$csconcat :: NonEmpty ShortText -> ShortText
<> :: ShortText -> ShortText -> ShortText
$c<> :: ShortText -> ShortText -> ShortText
Semigroup, Semigroup ShortText
ShortText
Semigroup ShortText
-> ShortText
-> (ShortText -> ShortText -> ShortText)
-> ([ShortText] -> ShortText)
-> Monoid ShortText
[ShortText] -> ShortText
ShortText -> ShortText -> ShortText
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [ShortText] -> ShortText
$cmconcat :: [ShortText] -> ShortText
mappend :: ShortText -> ShortText -> ShortText
$cmappend :: ShortText -> ShortText -> ShortText
mempty :: ShortText
$cmempty :: ShortText
Monoid, ShortText -> ()
(ShortText -> ()) -> NFData ShortText
forall a. (a -> ()) -> NFData a
rnf :: ShortText -> ()
$crnf :: ShortText -> ()
NFData)
instance IsString ShortText where
fromString :: String -> ShortText
fromString = String -> ShortText
pack
codepointLength :: ShortText -> Int
codepointLength :: ShortText -> Int
codepointLength ShortText
st = IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ ShortByteString -> IO Int
countUTF8Chars (ShortText -> ShortByteString
contents ShortText
st)
byteLength :: ShortText -> Int
byteLength :: ShortText -> Int
byteLength ShortText
st = ShortByteString -> Int
SBS.length (ShortByteString -> Int) -> ShortByteString -> Int
forall a b. (a -> b) -> a -> b
$ ShortText -> ShortByteString
contents ShortText
st
pack :: String -> ShortText
pack :: String -> ShortText
pack String
s = IO ShortText -> ShortText
forall a. IO a -> a
unsafeDupablePerformIO (IO ShortText -> ShortText) -> IO ShortText -> ShortText
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ShortText
ShortText (ShortByteString -> ShortText)
-> IO ShortByteString -> IO ShortText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ShortByteString
utf8EncodeShortByteString String
s
unpack :: ShortText -> String
unpack :: ShortText -> String
unpack ShortText
st = ShortByteString -> String
utf8DecodeShortByteString (ShortByteString -> String) -> ShortByteString -> String
forall a b. (a -> b) -> a -> b
$ ShortText -> ShortByteString
contents ShortText
st
null :: ShortText -> Bool
null :: ShortText -> Bool
null ShortText
st = ShortByteString -> Bool
SBS.null (ShortByteString -> Bool) -> ShortByteString -> Bool
forall a b. (a -> b) -> a -> b
$ ShortText -> ShortByteString
contents ShortText
st
splitFilePath :: ShortText -> [ShortText]
splitFilePath :: ShortText -> [ShortText]
splitFilePath ShortText
st = [ShortText] -> [ShortText]
forall a. NFData a => a -> a
DeepSeq.force ([ShortText] -> [ShortText]) -> [ShortText] -> [ShortText]
forall a b. (a -> b) -> a -> b
$ (ByteString -> ShortText) -> [ByteString] -> [ShortText]
forall a b. (a -> b) -> [a] -> [b]
map (ShortByteString -> ShortText
ShortText (ShortByteString -> ShortText)
-> (ByteString -> ShortByteString) -> ByteString -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort) ([ByteString] -> [ShortText]) -> [ByteString] -> [ShortText]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> [ByteString]
B8.splitWith Char -> Bool
isPathSeparator ByteString
st'
where st' :: ByteString
st' = ShortByteString -> ByteString
SBS.fromShort (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ShortText -> ShortByteString
contents ShortText
st
head :: ShortText -> Char
head :: ShortText -> Char
head ShortText
st
| ShortByteString -> Bool
SBS.null (ShortByteString -> Bool) -> ShortByteString -> Bool
forall a b. (a -> b) -> a -> b
$ ShortText -> ShortByteString
contents ShortText
st = String -> Char
forall a. HasCallStack => String -> a
error String
"head: Empty ShortText"
| Bool
otherwise = String -> Char
forall a. [a] -> a
Prelude.head (String -> Char) -> String -> Char
forall a b. (a -> b) -> a -> b
$ ShortText -> String
unpack ShortText
st
stripPrefix :: ShortText -> ShortText -> Maybe ShortText
stripPrefix :: ShortText -> ShortText -> Maybe ShortText
stripPrefix ShortText
prefix ShortText
st = do
let !(SBS.SBS ByteArray#
prefixBA) = ShortText -> ShortByteString
contents ShortText
prefix
let !(SBS.SBS ByteArray#
stBA) = ShortText -> ShortByteString
contents ShortText
st
let prefixLength :: Int#
prefixLength = ByteArray# -> Int#
sizeofByteArray# ByteArray#
prefixBA
let stLength :: Int#
stLength = ByteArray# -> Int#
sizeofByteArray# ByteArray#
stBA
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (Int# -> Int
I# Int#
stLength) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int# -> Int
I# Int#
prefixLength)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# (ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#
compareByteArrays# ByteArray#
prefixBA Int#
0# ByteArray#
stBA Int#
0# Int#
prefixLength) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
IO (Maybe ShortText) -> Maybe ShortText
forall a. IO a -> a
unsafeDupablePerformIO (IO (Maybe ShortText) -> Maybe ShortText)
-> IO (Maybe ShortText) -> Maybe ShortText
forall a b. (a -> b) -> a -> b
$ do
let newBAsize :: Int#
newBAsize = (Int#
stLength Int# -> Int# -> Int#
-# Int#
prefixLength)
ShortByteString
newSBS <- (State# RealWorld -> (# State# RealWorld, ShortByteString #))
-> IO ShortByteString
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, ShortByteString #))
-> IO ShortByteString)
-> (State# RealWorld -> (# State# RealWorld, ShortByteString #))
-> IO ShortByteString
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s0 ->
let !(# State# RealWorld
s1, MutableByteArray# RealWorld
ba #) = Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
newBAsize State# RealWorld
s0
s2 :: State# RealWorld
s2 = ByteArray#
-> Int#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
stBA Int#
prefixLength MutableByteArray# RealWorld
ba Int#
0# Int#
newBAsize State# RealWorld
s1
!(# State# RealWorld
s3, ByteArray#
fba #) = MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
ba State# RealWorld
s2
in (# State# RealWorld
s3, ByteArray# -> ShortByteString
SBS.SBS ByteArray#
fba #)
Maybe ShortText -> IO (Maybe ShortText)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ShortText -> IO (Maybe ShortText))
-> (ShortByteString -> Maybe ShortText)
-> ShortByteString
-> IO (Maybe ShortText)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Maybe ShortText
forall a. a -> Maybe a
Just (ShortText -> Maybe ShortText)
-> (ShortByteString -> ShortText)
-> ShortByteString
-> Maybe ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ShortText
ShortText (ShortByteString -> IO (Maybe ShortText))
-> ShortByteString -> IO (Maybe ShortText)
forall a b. (a -> b) -> a -> b
$ ShortByteString
newSBS