#if __GLASGOW_HASKELL__ < 710
#endif
module Fmt.Internal
(
FromBuilder(..),
FormatAsHex(..),
FormatAsBase64(..),
groupInt,
atBase,
showSigned',
intToDigit',
indent',
)
where
import Data.Monoid
import Numeric
import Data.Char
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TL
import qualified Data.Text.Lazy.Encoding as TL
import Data.Text.Buildable
import qualified Data.Text.Format as TF
import Data.Text.Lazy.Builder hiding (fromString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Base16.Lazy as B16L
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Base64.Lazy as B64L
import qualified Data.ByteString.Base64.URL as B64U
import qualified Data.ByteString.Base64.URL.Lazy as B64UL
class FromBuilder a where
fromBuilder :: Builder -> a
instance FromBuilder Builder where
fromBuilder = id
instance (a ~ Char) => FromBuilder [a] where
fromBuilder = TL.unpack . toLazyText
instance FromBuilder T.Text where
fromBuilder = TL.toStrict . toLazyText
instance FromBuilder TL.Text where
fromBuilder = toLazyText
instance (a ~ ()) => FromBuilder (IO a) where
fromBuilder = TL.putStr . toLazyText
class FormatAsHex a where
hexF :: a -> Builder
instance FormatAsHex BS.ByteString where
hexF = fromText . T.decodeLatin1 . B16.encode
instance FormatAsHex BSL.ByteString where
hexF = fromLazyText . TL.decodeLatin1 . B16L.encode
#if __GLASGOW_HASKELL__ >= 710
instance Integral a => FormatAsHex a where
hexF = TF.hex
#else
instance Integral a => FormatAsHex a where
hexF = TF.hex
#endif
class FormatAsBase64 a where
base64F :: a -> Builder
base64UrlF :: a -> Builder
instance FormatAsBase64 BS.ByteString where
base64F = fromText . T.decodeLatin1 . B64.encode
base64UrlF = fromText . T.decodeLatin1 . B64U.encode
instance FormatAsBase64 BSL.ByteString where
base64F = fromLazyText . TL.decodeLatin1 . B64L.encode
base64UrlF = fromLazyText . TL.decodeLatin1 . B64UL.encode
groupInt :: (Buildable a, Integral a) => Int -> Char -> a -> Builder
groupInt 0 _ n = build n
groupInt i c n =
fromLazyText . TL.reverse .
foldr merge "" .
TL.zip (zeros <> cycle' zeros') .
TL.reverse .
toLazyText . build
$ n
where
zeros = TL.replicate (fromIntegral i) (TL.singleton '0')
zeros' = TL.singleton c <> TL.tail zeros
merge (f, c') rest
| f == c = TL.singleton c <> TL.singleton c' <> rest
| otherwise = TL.singleton c' <> rest
cycle' xs = xs <> cycle' xs
_ = toInteger n
atBase :: Integral a => Int -> a -> String
atBase b _ | b < 2 || b > 36 = error ("baseF: Invalid base " ++ show b)
atBase b n =
showSigned' (showIntAtBase (toInteger b) intToDigit') (toInteger n) ""
showSigned' :: Real a => (a -> ShowS) -> a -> ShowS
showSigned' f n
| n < 0 = showChar '-' . f (negate n)
| otherwise = f n
intToDigit' :: Int -> Char
intToDigit' i
| i >= 0 && i < 10 = chr (ord '0' + i)
| i >= 10 && i < 36 = chr (ord 'a' + i 10)
| otherwise = error ("intToDigit': Invalid int " ++ show i)
indent' :: Int -> T.Text -> Builder -> Builder
indent' n pref a = go True (toLazyText a)
where
spaces = fromText (T.replicate n (T.singleton ' '))
go isFirst t
| TL.null t = if isFirst then fromText pref else ""
| otherwise = let (l, t') = TL.break ((==) '\n') t
in (if isFirst then fromText pref else spaces) <>
if TL.null t'
then fromLazyText l
else fromLazyText l <> singleton '\n' <>
go False (TL.tail t')