{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
module VtUtils.Text
( textShow
, textSplit
, textFormatParts
, textFormat
) where
import Prelude (Maybe, Show, String, (+), (-), (.), ($), (==), (/=), fst, error, otherwise, show)
import Data.ByteString (ByteString)
import Data.Maybe (isJust, fromJust)
import Data.Monoid ((<>))
import Data.List (reverse)
import qualified Data.Text as Text
import Data.Text (Text, breakOnAll, drop, pack, unpack)
import Data.Text.Encoding (decodeUtf8)
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (fromText, toLazyText)
import Data.Typeable (Typeable, cast)
import Data.Vector (Vector, (!), fromList, ifoldl', length)
textShow :: (Show a, Typeable a) => a -> Text
textShow val
| isJust castedText = fromJust castedText
| isJust castedString = pack (fromJust castedString)
| isJust castedBytes = decodeUtf8 (fromJust castedBytes)
| otherwise = pack (show val)
where
castedText = cast val :: Maybe Text
castedString = cast val :: Maybe String
castedBytes = cast val :: Maybe ByteString
textSplit :: Text -> Text -> Vector Text
textSplit haystack needle =
(fromList . reverse) $ fst $ ifoldl' fun ([], 0) pairs
where
nl = Text.length needle
empt parts
| 0 == length parts = fromList [(haystack, "")]
| otherwise = parts
pairs = empt $ fromList $ breakOnAll needle haystack
fun (ac, al) idx (pref, suf)
| (length pairs) - 1 == idx =
if 0 /= Text.length suf then
(drop nl suf : drop al pref : ac, 0)
else
(drop al pref : ac, 0)
| 0 == idx = ([pref], (Text.length pref) + nl)
| otherwise = (drop al pref : ac, (Text.length pref) + nl)
textFormatParts :: Vector Text -> Vector Text -> Text
textFormatParts parts params =
toStrict $ toLazyText $ ifoldl' fun (fromText "") (check parts)
where
check vec =
if (length vec) == (length params) + 1 then
vec
else
error . unpack $
"Invalid format string,"
<> " placeholders count: [" <> (textShow ((length vec) - 1)) <> "],"
<> " parameters count: [" <> (textShow (length params)) <> "]"
fun ac idx el
| length params == idx = ac <> (fromText el)
| otherwise = ac <> (fromText el) <> (fromText $ params ! idx)
textFormat :: Text -> Vector Text -> Text
textFormat template params =
textFormatParts (textSplit template "{}") params