{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module Network.DNS.Internal
( DomainLabel(..)
, Domain(..)
, DList(..)
, toDList
, fromDList
, singleton
, sbsMap
, sbsSingleton
)
where
import Data.Function (on)
import GHC.Word
#if !MIN_VERSION_bytestring(0,11,3)
import Control.Monad.ST (runST)
import Data.ByteString.Short.Internal (ShortByteString(SBS))
import GHC.Exts (Int#, MutableByteArray#, indexWord8Array#,
newByteArray#, unsafeFreezeByteArray#,
writeWord8Array#, (+#))
import GHC.Int (Int(..))
import GHC.ST (ST(..))
#endif
import qualified Data.ByteString.Short as BS
data DomainLabel = DomainLabel { DomainLabel -> ShortByteString
getDomainLabel_ :: !BS.ShortByteString
, DomainLabel -> ShortByteString
getDomainLabelCF_ :: !BS.ShortByteString }
newtype Domain = Domain [DomainLabel] deriving (Domain -> Domain -> Bool
(Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool) -> Eq Domain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Domain -> Domain -> Bool
$c/= :: Domain -> Domain -> Bool
== :: Domain -> Domain -> Bool
$c== :: Domain -> Domain -> Bool
Eq, Eq Domain
Eq Domain
-> (Domain -> Domain -> Ordering)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Domain)
-> (Domain -> Domain -> Domain)
-> Ord Domain
Domain -> Domain -> Bool
Domain -> Domain -> Ordering
Domain -> Domain -> Domain
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 :: Domain -> Domain -> Domain
$cmin :: Domain -> Domain -> Domain
max :: Domain -> Domain -> Domain
$cmax :: Domain -> Domain -> Domain
>= :: Domain -> Domain -> Bool
$c>= :: Domain -> Domain -> Bool
> :: Domain -> Domain -> Bool
$c> :: Domain -> Domain -> Bool
<= :: Domain -> Domain -> Bool
$c<= :: Domain -> Domain -> Bool
< :: Domain -> Domain -> Bool
$c< :: Domain -> Domain -> Bool
compare :: Domain -> Domain -> Ordering
$ccompare :: Domain -> Domain -> Ordering
Ord)
instance Ord DomainLabel where
<= :: DomainLabel -> DomainLabel -> Bool
(<=) = ShortByteString -> ShortByteString -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (ShortByteString -> ShortByteString -> Bool)
-> (DomainLabel -> ShortByteString)
-> DomainLabel
-> DomainLabel
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DomainLabel -> ShortByteString
getDomainLabelCF_
compare :: DomainLabel -> DomainLabel -> Ordering
compare = ShortByteString -> ShortByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ShortByteString -> ShortByteString -> Ordering)
-> (DomainLabel -> ShortByteString)
-> DomainLabel
-> DomainLabel
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DomainLabel -> ShortByteString
getDomainLabelCF_
instance Eq DomainLabel where
== :: DomainLabel -> DomainLabel -> Bool
(==) = ShortByteString -> ShortByteString -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ShortByteString -> ShortByteString -> Bool)
-> (DomainLabel -> ShortByteString)
-> DomainLabel
-> DomainLabel
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DomainLabel -> ShortByteString
getDomainLabelCF_
newtype DList a = DList ([a] -> [a])
{-# INLINE toDList #-}
toDList :: [a] -> DList a
toDList :: forall a. [a] -> DList a
toDList = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList (([a] -> [a]) -> DList a) -> ([a] -> [a] -> [a]) -> [a] -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)
{-# INLINE fromDList #-}
fromDList :: DList a -> [a]
fromDList :: forall a. DList a -> [a]
fromDList (DList [a] -> [a]
dl) = [a] -> [a]
dl []
{-# INLINE singleton #-}
singleton :: a -> DList a
singleton :: forall a. a -> DList a
singleton = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList (([a] -> [a]) -> DList a) -> (a -> [a] -> [a]) -> a -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:)
instance Semigroup (DList a) where
{-# INLINE (<>) #-}
DList [a] -> [a]
l <> :: DList a -> DList a -> DList a
<> DList [a] -> [a]
r = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList ([a] -> [a]
l ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
r)
instance Monoid (DList a) where
{-# INLINE mempty #-}
mempty :: DList a
mempty = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList [a] -> [a]
forall a. a -> a
id
{-# INLINE sbsSingleton #-}
sbsSingleton :: Word8 -> BS.ShortByteString
#if MIN_VERSION_bytestring(0,11,3)
sbsSingleton = BS.singleton
#else
sbsSingleton :: Word8 -> ShortByteString
sbsSingleton (W8# Word#
w) = (forall s. ST s ShortByteString) -> ShortByteString
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ShortByteString) -> ShortByteString)
-> (forall s. ST s ShortByteString) -> ShortByteString
forall a b. (a -> b) -> a -> b
$ STRep s ShortByteString -> ST s ShortByteString
forall s a. STRep s a -> ST s a
ST (STRep s ShortByteString -> ST s ShortByteString)
-> STRep s ShortByteString -> ST s ShortByteString
forall a b. (a -> b) -> a -> b
$ \State# s
s1 ->
case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
1# State# s
s1 of
(# State# s
s2, MutableByteArray# s
mba #) -> case MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
mba Int#
0# Word#
w State# s
s2 of
State# s
s3 -> case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba State# s
s3 of
(# State# s
s4, ByteArray#
ma #) -> (# State# s
s4, ByteArray# -> ShortByteString
SBS ByteArray#
ma #)
#endif
sbsMap :: (Word8 -> Word8) -> BS.ShortByteString -> BS.ShortByteString
#if MIN_VERSION_bytestring(0,11,3)
sbsMap = BS.map
#else
sbsMap :: (Word8 -> Word8) -> ShortByteString -> ShortByteString
sbsMap Word8 -> Word8
m sbs :: ShortByteString
sbs@(SBS ByteArray#
ba) = (forall s. ST s ShortByteString) -> ShortByteString
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ShortByteString) -> ShortByteString)
-> (forall s. ST s ShortByteString) -> ShortByteString
forall a b. (a -> b) -> a -> b
$ STRep s ShortByteString -> ST s ShortByteString
forall s a. STRep s a -> ST s a
ST (STRep s ShortByteString -> ST s ShortByteString)
-> STRep s ShortByteString -> ST s ShortByteString
forall a b. (a -> b) -> a -> b
$ \State# s
s1 ->
case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
l# State# s
s1 of
(# State# s
s2, MutableByteArray# s
mba #) -> case MutableByteArray# s -> Int# -> Int# -> ST s ()
forall s. MutableByteArray# s -> Int# -> Int# -> ST s ()
go MutableByteArray# s
mba Int#
0# Int#
l# of
ST STRep s ()
f -> case STRep s ()
f State# s
s2 of
(# State# s
s3, ()
_ #) -> case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba State# s
s3 of
(# State# s
s4, ByteArray#
ma #) -> (# State# s
s4, ByteArray# -> ShortByteString
SBS ByteArray#
ma #)
where
!(I# Int#
l#) = ShortByteString -> Int
BS.length ShortByteString
sbs
go :: MutableByteArray# s -> Int# -> Int# -> ST s ()
go :: forall s. MutableByteArray# s -> Int# -> Int# -> ST s ()
go !MutableByteArray# s
mba !Int#
i !Int#
l
| Int# -> Int
I# Int#
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int# -> Int
I# Int#
l = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = (STRep s () -> ST s ()
forall s a. STRep s a -> ST s a
ST (STRep s () -> ST s ()) -> STRep s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
let !(W8# Word#
w') = Word8 -> Word8
m (Word# -> Word8
W8# (ByteArray# -> Int# -> Word#
indexWord8Array# ByteArray#
ba Int#
i)) in
(# MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
mba Int#
i Word#
w' State# s
s, () #)
) ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MutableByteArray# s -> Int# -> Int# -> ST s ()
forall s. MutableByteArray# s -> Int# -> Int# -> ST s ()
go MutableByteArray# s
mba (Int#
i Int# -> Int# -> Int#
+# Int#
1#) Int#
l
#endif