module Data.Conduit.Parsers.Text.Gen
( PutM
, TextGen
, runTextGen
, genString
, genLazyString
, genShow
, genDigit
, genHexDigit
, genHexByte
, genEnum
) where
import Data.Bits
import Data.Char
import Data.Conduit hiding (ConduitM)
import qualified Data.Text as S (Text)
import qualified Data.Text as ST hiding (Text, head, last, tail, init)
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as T hiding (Text, head, last, tail, init)
import Data.Word
import Data.Conduit.Parsers.PutS
class (EncodingState s, EncodingToken s ~ ()) => DefaultTextGenState s where
instance (EncodingState s, EncodingToken s ~ ()) => DefaultTextGenState s where
type TextGen = forall s i m. (DefaultTextGenState s, Monad m) => PutM s i S.Text m ()
runTextGen :: PutM VoidEncodingState i o m () -> ConduitT i o m ()
runTextGen !p = runEncoding $ snd $ runPutS p $ startEncoding VoidEncodingState
{-# INLINE runTextGen #-}
genString :: S.Text -> TextGen
genString !x = putS $ \ !t -> ((), encoded (yield x, ()) t)
{-# INLINE genString #-}
genLazyString :: Text -> TextGen
genLazyString !x = putS $ \ !t -> ((), encoded (mapM_ yield $ T.toChunks x, ()) t)
{-# INLINE genLazyString #-}
genShow :: Show a => a -> TextGen
genShow = genLazyString . T.pack . show
{-# INLINE genShow #-}
genDigit :: Integral a => a -> TextGen
genDigit !x
| x < 0 || x >= 10 = error "genDigit"
| otherwise = genString $ ST.singleton $ chr $ ord '0' + fromIntegral x
{-# INLINE genDigit #-}
genHexDigit :: Integral a => Bool -> a -> TextGen
genHexDigit !uppercase =
genString . ST.singleton . chr . toCharCode . fromIntegral
where
toCharCode !x
| x < 0 || x >= 16 = error "genHexDigit"
| x < 10 = ord '0' + x
| otherwise = (if uppercase then ord 'A' else ord 'a') + (x - 10)
{-# INLINE genHexDigit #-}
genHexByte :: Bool -> Word8 -> TextGen
genHexByte !uppercase !c = do
genHexDigit uppercase $ c `shiftR` 4
genHexDigit uppercase $ c .&. 0xF
{-# INLINE genHexByte #-}
genEnum :: (Eq a, Ord a, Enum a, Bounded a, Show a) => Int -> a -> TextGen
genEnum !prefix = genString . ST.drop prefix . ST.pack . show
{-# INLINE genEnum #-}