Internal.hs

-- |
-- Module      : Network.DNS.Pattern.Internal
-- Description : Internal DNS types and definitions
--
-- This module is not part of public API and may change even between patch versions.

module Network.DNS.Internal
  ( DomainLabel(..)
  , Domain(..)
  , DList(..)
  , toDList
  , fromDList
  , singleton
  )

where

import           Data.Function (on)

import qualified Data.ByteString.Short as BS

-- | Domain label with case-insensitive 'Eq' and 'Ord' as per [RFC4343](https://datatracker.ietf.org/doc/html/rfc4343#section-3).
data DomainLabel = DomainLabel { getDomainLabel_ :: !BS.ShortByteString
                               , getDomainLabelCF_ :: !BS.ShortByteString }

-- | A domain parsed into labels. Each label is a 'BS.ShortByteString' rather than 'T.Text' or 'String' because a label can contain arbitrary bytes.
-- However, the 'Ord' and 'Eq' instances do limited case-folding according to [RFC4343](https://datatracker.ietf.org/doc/html/rfc4343#section-3).
newtype Domain = Domain [DomainLabel] deriving (Eq, Ord)

instance Ord DomainLabel where
  (<=) = (<=) `on` getDomainLabelCF_
  compare = compare `on` getDomainLabelCF_

instance Eq DomainLabel where
  (==) = (==) `on` getDomainLabelCF_

-- | Difference list à la Huhges
newtype DList a = DList ([a] -> [a])

-- | Turn a list into 'DList'
{-# INLINE toDList #-}
toDList :: [a] -> DList a
toDList = DList . (++)

-- | Turn 'DList' back into a list.
{-# INLINE fromDList #-}
fromDList :: DList a -> [a]
fromDList (DList dl) = dl []

-- | Create a 'DList' containing just the specified element
{-# INLINE singleton #-}
singleton :: a -> DList a
singleton = DList . (:)

instance Semigroup (DList a) where
  {-# INLINE (<>) #-}
  DList l <> DList r = DList (l . r)

instance Monoid (DList a) where
  {-# INLINE mempty #-}
  mempty = DList id