{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
module Serokell.Util.Text
(
FPFormat (..)
, showFloat
, showFloat'
, showFixedPretty'
, showDecimal
, showDecimal'
, pairF
, tripleF
, listJson
, listMap
, listJsonIndent
, listChunkedJson
, listCsv
, mapJson
, pairBuilder
, tripleBuilder
, listBuilder
, listBuilderJSON
, listBuilderJSONIndent
, listChunkedBuilderJson
, listBuilderCSV
, mapBuilder
, mapBuilderJson
, readFractional
, readDouble
, readDecimal
, readUnsignedDecimal
) where
import Prelude
import Data.Text.Lazy.Builder.RealFloat (FPFormat (Exponent, Fixed, Generic))
import Formatting (bprint, (%))
import Formatting (Format, fixed, later, sformat)
import Formatting.Buildable (Buildable (build))
import GHC.Exts (IsList (..))
import Serokell.Util.Common (chunksOf)
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy.Builder.Int as B
import qualified Data.Text.Lazy.Builder.RealFloat as B
import qualified Data.Text.Read as T
import qualified Formatting.Formatters as F
import qualified Universum as U
showFixedPretty'
:: Real a
=> Int -> a -> T.Text
showFixedPretty' prec =
T.dropWhileEnd (== '.') . T.dropWhileEnd (== '0') . sformat (fixed prec)
showFloat
:: (RealFloat a)
=> FPFormat -> Maybe Int -> a -> LT.Text
showFloat f precision v = B.toLazyText $ B.formatRealFloat f precision v
showFloat'
:: (RealFloat a)
=> FPFormat -> Maybe Int -> a -> T.Text
showFloat' f prec = LT.toStrict . showFloat f prec
showDecimal :: (Integral a)
=> a -> LT.Text
showDecimal = B.toLazyText . B.decimal
showDecimal' :: (Integral a)
=> a -> T.Text
showDecimal' = LT.toStrict . showDecimal
pairF :: (Buildable a, Buildable b) => Format r ((a,b) -> r)
pairF = later pairBuilder
tripleF :: (Buildable a, Buildable b, Buildable c) => Format r ((a,b,c) -> r)
tripleF = later tripleBuilder
listJson :: (Foldable t, Buildable a) => Format r (t a -> r)
listJson = later listBuilderJSON
listMap :: (Traversable t, Buildable a, Buildable b) => Format r (t (a, b) -> r)
listMap = later mapBuilder
listJsonIndent :: (Foldable t, Buildable a) => Word -> Format r (t a -> r)
listJsonIndent = later . listBuilderJSONIndent
listChunkedJson
:: (U.Container l, Buildable (U.Element l))
=> Int -> Format r (l -> r)
listChunkedJson chunkSize = later $ listChunkedBuilderJson chunkSize
listCsv :: (Foldable t, Buildable a) => Format r (t a -> r)
listCsv = later listBuilderCSV
mapJson :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v)
=> Format r (t -> r)
mapJson = later mapBuilderJson
pairBuilder
:: (Buildable a, Buildable b)
=> (a, b) -> B.Builder
pairBuilder (a, b) = bprint ("(" % F.build % ", " % F.build % ")") a b
tripleBuilder
:: (Buildable a, Buildable b, Buildable c)
=> (a, b, c) -> B.Builder
tripleBuilder (a, b, c) =
bprint ("("%F.build%", "%F.build%", "%F.build%")") a b c
listBuilder
:: (Buildable prefix, Buildable delimiter, Buildable suffix, Foldable t, Buildable a)
=> prefix -> delimiter -> suffix -> t a -> B.Builder
listBuilder prefix delimiter suffix as =
mconcat [build prefix, mconcat builders, build suffix]
where builders = foldr appendBuilder [] as
appendBuilder a [] = [build a]
appendBuilder a bs = build a : build delimiter : bs
_listBuilder
:: (Foldable t, Buildable a)
=> B.Builder -> B.Builder -> B.Builder -> t a -> B.Builder
_listBuilder = listBuilder
listBuilderJSON
:: (Foldable t, Buildable a)
=> t a -> B.Builder
listBuilderJSON = _listBuilder "[" ", " "]"
listBuilderJSONIndent
:: (Foldable t, Buildable a)
=> Word -> t a -> B.Builder
listBuilderJSONIndent _ as | null as = "[]"
listBuilderJSONIndent indent as =
listBuilder ("[\n" `LT.append` spaces)
delimiter
("\n]" :: B.Builder)
as
where spaces =
LT.replicate (fromIntegral indent)
" "
delimiter = ",\n" `LT.append` spaces
listChunkedBuilderJson
:: (U.Container l, Buildable (U.Element l))
=> Int -> l -> B.Builder
listChunkedBuilderJson chunkSize values
| U.null values = "[]"
| otherwise =
_listBuilder "[" "" (newline U.<> "]") $
_listBuilder newline ", " "" <$>
chunksOf chunkSize (U.toList values)
where
newline = "\n "
listBuilderCSV
:: (Foldable t, Buildable a)
=> t a -> B.Builder
listBuilderCSV = _listBuilder "" "," ""
mapBuilder
:: (Traversable t, Buildable k, Buildable v)
=> t (k, v) -> B.Builder
mapBuilder = listBuilderJSON . fmap pairBuilder
mapBuilderJson
:: (IsList t, Item t ~ (k, v), Buildable k, Buildable v)
=> t -> B.Builder
mapBuilderJson = _listBuilder "{" ", " "}" .
map (\(a, b) -> bprint (F.build % ": " % F.build) a b) . toList
readFractional :: Fractional a => T.Text -> Either String a
readFractional = _wrapReader T.rational
readDouble :: T.Text -> Either String Double
readDouble = _wrapReader T.double
readDecimal :: Integral a => T.Text -> Either String a
readDecimal = _wrapReader $ T.signed T.decimal
readUnsignedDecimal :: Integral a => T.Text -> Either String a
readUnsignedDecimal = _wrapReader T.decimal
_wrapReader :: T.Reader a -> T.Text -> Either String a
_wrapReader reader t =
case reader t of
Left err -> Left $ mconcat [ "failed to parse '"
, T.unpack t
, "': "
, err
]
Right (res, "") -> Right res
Right (_, remainder) ->
Left $
mconcat [ "failed to parse '"
, T.unpack t
, "', because there is a remainder: "
, T.unpack remainder
]