Skip to content

Commit

Permalink
instance IsList Builder
Browse files Browse the repository at this point in the history
  • Loading branch information
BebeSparkelSparkel committed Apr 11, 2024
1 parent 46a3aeb commit ec8140e
Showing 1 changed file with 8 additions and 0 deletions.
8 changes: 8 additions & 0 deletions Data/ByteString/Builder/Internal.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE Unsafe #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_HADDOCK not-home #-}

Expand Down Expand Up @@ -128,6 +129,7 @@ module Data.ByteString.Builder.Internal (
) where

import Control.Arrow (second)
import GHC.Exts (IsList(..))

import Data.Semigroup (Semigroup(..))
import Data.List.NonEmpty (NonEmpty(..))
Expand Down Expand Up @@ -414,6 +416,12 @@ instance Monoid Builder where
{-# INLINE mconcat #-}
mconcat = foldr mappend mempty

instance IsList Builder where
type Item Builder = Word8
fromList = byteStringInsert . fromList
fromListN n = byteStringThreshold n . fromList
toList = toList . toLazyByteStringWith (safeStrategy L.smallChunkSize L.smallChunkSize) mempty

-- | Flush the current buffer. This introduces a chunk boundary.
{-# INLINE flush #-}
flush :: Builder
Expand Down

0 comments on commit ec8140e

Please sign in to comment.