module Buffet.Toolbox.TextTools
  ( decodeUtf8
  , defaultJsonOptions
  , encodeUtf8
  , intercalateNewline
  , lexicographicalCompare
  , prettyPrintJson
  ) where

import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encode.Pretty as Pretty
import qualified Data.ByteString.Lazy as ByteString
import qualified Data.Ord as Ord
import qualified Data.Text as T
import qualified Data.Text.Lazy as Lazy
import qualified Data.Text.Lazy.Encoding as Encoding
import Prelude (Bool(True), Ordering, (.))

decodeUtf8 :: ByteString.ByteString -> T.Text
decodeUtf8 :: ByteString -> Text
decodeUtf8 = Text -> Text
Lazy.toStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Encoding.decodeUtf8

defaultJsonOptions :: Aeson.Options
defaultJsonOptions :: Options
defaultJsonOptions =
  Options
Aeson.defaultOptions {fieldLabelModifier :: String -> String
Aeson.fieldLabelModifier = Char -> String -> String
Aeson.camelTo2 Char
'_'}

encodeUtf8 :: T.Text -> ByteString.ByteString
encodeUtf8 :: Text -> ByteString
encodeUtf8 = Text -> ByteString
Encoding.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Lazy.fromStrict

intercalateNewline :: [T.Text] -> T.Text
intercalateNewline :: [Text] -> Text
intercalateNewline = Text -> [Text] -> Text
T.intercalate Text
newline
  where
    newline :: Text
newline = String -> Text
T.pack String
"\n"

lexicographicalCompare :: T.Text -> T.Text -> Ordering
lexicographicalCompare :: Text -> Text -> Ordering
lexicographicalCompare = (Text -> (Text, Text)) -> Text -> Text -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing Text -> (Text, Text)
sortKey
  where
    sortKey :: Text -> (Text, Text)
sortKey Text
text = (Text -> Text
T.toCaseFold Text
text, Text
text)

prettyPrintJson :: Aeson.ToJSON a => a -> T.Text
prettyPrintJson :: a -> Text
prettyPrintJson = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Value -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
Pretty.encodePretty' Config
configuration (Value -> ByteString) -> (a -> Value) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON
  where
    configuration :: Config
configuration =
      Config
Pretty.defConfig
        { confIndent :: Indent
Pretty.confIndent = Int -> Indent
Pretty.Spaces Int
2
        , confCompare :: Text -> Text -> Ordering
Pretty.confCompare = Text -> Text -> Ordering
lexicographicalCompare
        , confTrailingNewline :: Bool
Pretty.confTrailingNewline = Bool
True
        }