module Text.Builder
(
Builder,
run,
length,
null,
char,
text,
string,
unicodeCodePoint,
utf16CodeUnits1,
utf16CodeUnits2,
utf8CodeUnits1,
utf8CodeUnits2,
utf8CodeUnits3,
utf8CodeUnits4,
integral,
)
where
import Text.Builder.Prelude hiding (length, null)
import qualified Data.Text.Array as B
import qualified Data.Text.Internal as C
import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding.Error as E
import qualified Text.Builder.UTF16 as D
newtype Action =
Action (forall s. B.MArray s -> Int -> ST s ())
data Builder =
Builder !Action !Int
instance Monoid Builder where
mempty =
Builder (Action (\_ _ -> return ())) 0
mappend (Builder (Action action1) size1) (Builder (Action action2) size2) =
Builder action size
where
action =
Action $ \array offset -> do
action1 array offset
action2 array (offset + size1)
size =
size1 + size2
instance Semigroup Builder
char :: Char -> Builder
char x =
unicodeCodePoint (ord x)
unicodeCodePoint :: Int -> Builder
unicodeCodePoint x =
D.unicodeCodePoint x utf16CodeUnits1 utf16CodeUnits2
utf16CodeUnits1 :: Word16 -> Builder
utf16CodeUnits1 unit =
Builder action 1
where
action =
Action $ \array offset -> B.unsafeWrite array offset unit
utf16CodeUnits2 :: Word16 -> Word16 -> Builder
utf16CodeUnits2 unit1 unit2 =
Builder action 2
where
action =
Action $ \array offset -> do
B.unsafeWrite array offset unit1
B.unsafeWrite array (succ offset) unit2
utf8CodeUnits1 :: Word8 -> Builder
utf8CodeUnits1 unit1 =
D.utf8CodeUnits1 unit1 utf16CodeUnits1 utf16CodeUnits2
utf8CodeUnits2 :: Word8 -> Word8 -> Builder
utf8CodeUnits2 unit1 unit2 =
D.utf8CodeUnits2 unit1 unit2 utf16CodeUnits1 utf16CodeUnits2
utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> Builder
utf8CodeUnits3 unit1 unit2 unit3 =
D.utf8CodeUnits3 unit1 unit2 unit3 utf16CodeUnits1 utf16CodeUnits2
utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> Builder
utf8CodeUnits4 unit1 unit2 unit3 unit4 =
D.utf8CodeUnits4 unit1 unit2 unit3 unit4 utf16CodeUnits1 utf16CodeUnits2
text :: Text -> Builder
text (C.Text array offset length) =
Builder action actualLength
where
action =
Action $ \builderArray builderOffset -> do
B.copyI builderArray builderOffset array offset (builderOffset + actualLength)
actualLength =
length offset
string :: String -> Builder
string =
foldMap char
integral :: Integral a => a -> Builder
integral =
\case
0 ->
unicodeCodePoint 48
x ->
bool ((<>) (unicodeCodePoint 45)) id (x >= 0) $
loop mempty $
abs x
where
loop builder remainder =
case remainder of
0 ->
builder
_ ->
case quotRem remainder 10 of
(quot, rem) ->
loop (unicodeCodePoint (48 + fromIntegral rem) <> builder) quot
length :: Builder -> Int
length (Builder _ x) = x
null :: Builder -> Bool
null = (== 0) . length
run :: Builder -> Text
run (Builder (Action action) size) =
C.text array 0 size
where
array =
runST $ do
array <- B.new size
action array 0
B.unsafeFreeze array