{-# LANGUAGE OverloadedStrings #-}

module Test.Tasty.AutoCollect.Utils.Text (
  withoutPrefix,
  withoutSuffix,
  breakOnEnd,
  listify,
  quoted,
) where

import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text

withoutPrefix :: Text -> Text -> Text
withoutPrefix :: Text -> Text -> Text
withoutPrefix Text
pre Text
s = forall a. a -> Maybe a -> a
fromMaybe Text
s forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
Text.stripPrefix Text
pre Text
s

withoutSuffix :: Text -> Text -> Text
withoutSuffix :: Text -> Text -> Text
withoutSuffix Text
post Text
s = forall a. a -> Maybe a -> a
fromMaybe Text
s forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
Text.stripSuffix Text
post Text
s

-- | Same as 'Text.breakOnEnd', but omits the delimiter
breakOnEnd :: Text -> Text -> (Text, Text)
breakOnEnd :: Text -> Text -> (Text, Text)
breakOnEnd Text
delim Text
s =
  let (Text
a, Text
b) = Text -> Text -> (Text, Text)
Text.breakOnEnd Text
delim Text
s
   in (forall a. a -> Maybe a -> a
fromMaybe Text
a (Text -> Text -> Maybe Text
Text.stripSuffix Text
delim Text
a), Text
b)

-- | Convert a list @["a", "b"]@ to the text @"[\"a\", \"b\"]"@.
listify :: [Text] -> Text
listify :: [Text] -> Text
listify [Text]
xs = Text
"[" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
xs forall a. Semigroup a => a -> a -> a
<> Text
"]"

quoted :: Text -> Text
quoted :: Text -> Text
quoted Text
s = Text
"\"" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
"\""