{-# LANGUAGE UndecidableInstances #-}

module Shrun.Data.Text
  ( UnlinedText (..),

    -- * Creation
    fromText,
    fromTextReplace,
    unsafeUnlinedText,

    -- * Elimination
    toText,

    -- * Functions
    concat,
    intercalate,
    reallyUnsafeLiftUnlined,
  )
where

import Data.String (IsString (fromString))
import Data.Text qualified as T
import Shrun.Prelude

-- | Text after it has had all lines separated into different texts. We
-- introduce a newtype for clarity. The idea is that when we read arbitrary
-- text from a handle, this type serves as a witness that we have indeed split
-- the string along newlines. Then, in the normal case, we log each line
-- separately.
--
-- In exceptional cases (e.g. command names), we may choose to combine the
-- list back into a single text, according to some logic.
--
-- The constructor 'UnsafeUnlinedText' should only be used when we __know__
-- the text has no newlines and performance means a branch is undesirable
-- (e.g. streaming). If there is no performance impact, consider
-- 'unsafeUnlinedText' instead.
newtype UnlinedText = UnsafeUnlinedText {UnlinedText -> Text
unUnlinedText :: Text}
  deriving stock (UnlinedText -> UnlinedText -> Bool
(UnlinedText -> UnlinedText -> Bool)
-> (UnlinedText -> UnlinedText -> Bool) -> Eq UnlinedText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnlinedText -> UnlinedText -> Bool
== :: UnlinedText -> UnlinedText -> Bool
$c/= :: UnlinedText -> UnlinedText -> Bool
/= :: UnlinedText -> UnlinedText -> Bool
Eq, Int -> UnlinedText -> ShowS
[UnlinedText] -> ShowS
UnlinedText -> String
(Int -> UnlinedText -> ShowS)
-> (UnlinedText -> String)
-> ([UnlinedText] -> ShowS)
-> Show UnlinedText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnlinedText -> ShowS
showsPrec :: Int -> UnlinedText -> ShowS
$cshow :: UnlinedText -> String
show :: UnlinedText -> String
$cshowList :: [UnlinedText] -> ShowS
showList :: [UnlinedText] -> ShowS
Show)
  deriving (Semigroup UnlinedText
UnlinedText
Semigroup UnlinedText =>
UnlinedText
-> (UnlinedText -> UnlinedText -> UnlinedText)
-> ([UnlinedText] -> UnlinedText)
-> Monoid UnlinedText
[UnlinedText] -> UnlinedText
UnlinedText -> UnlinedText -> UnlinedText
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: UnlinedText
mempty :: UnlinedText
$cmappend :: UnlinedText -> UnlinedText -> UnlinedText
mappend :: UnlinedText -> UnlinedText -> UnlinedText
$cmconcat :: [UnlinedText] -> UnlinedText
mconcat :: [UnlinedText] -> UnlinedText
Monoid, NonEmpty UnlinedText -> UnlinedText
UnlinedText -> UnlinedText -> UnlinedText
(UnlinedText -> UnlinedText -> UnlinedText)
-> (NonEmpty UnlinedText -> UnlinedText)
-> (forall b. Integral b => b -> UnlinedText -> UnlinedText)
-> Semigroup UnlinedText
forall b. Integral b => b -> UnlinedText -> UnlinedText
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: UnlinedText -> UnlinedText -> UnlinedText
<> :: UnlinedText -> UnlinedText -> UnlinedText
$csconcat :: NonEmpty UnlinedText -> UnlinedText
sconcat :: NonEmpty UnlinedText -> UnlinedText
$cstimes :: forall b. Integral b => b -> UnlinedText -> UnlinedText
stimes :: forall b. Integral b => b -> UnlinedText -> UnlinedText
Semigroup) via Text

instance IsString UnlinedText where
  fromString :: String -> UnlinedText
fromString = Text -> UnlinedText
fromTextReplace (Text -> UnlinedText) -> (String -> Text) -> String -> UnlinedText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

instance
  ( k ~ A_Getter,
    a ~ Text,
    b ~ Text
  ) =>
  LabelOptic "unUnlinedText" k UnlinedText UnlinedText a b
  where
  labelOptic :: Optic k NoIx UnlinedText UnlinedText a b
labelOptic = (UnlinedText -> a) -> Getter UnlinedText a
forall s a. (s -> a) -> Getter s a
to (\(UnsafeUnlinedText Text
ts) -> a
Text
ts)
  {-# INLINE labelOptic #-}

-- | Creates a list of 'UnlinedText'.
fromText :: Text -> List UnlinedText
fromText :: Text -> [UnlinedText]
fromText = (Text -> UnlinedText) -> [Text] -> [UnlinedText]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> UnlinedText
UnsafeUnlinedText ([Text] -> [UnlinedText])
-> (Text -> [Text]) -> Text -> [UnlinedText]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

-- | Creates a single 'UnlinedText' by replacing newlines with
-- whitespace.
fromTextReplace :: Text -> UnlinedText
fromTextReplace :: Text -> UnlinedText
fromTextReplace = Text -> UnlinedText
UnsafeUnlinedText (Text -> UnlinedText) -> (Text -> Text) -> Text -> UnlinedText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\n" Text
" "

-- | Unsafe creation that throws error when the text contains newline(s).
unsafeUnlinedText :: (HasCallStack) => Text -> UnlinedText
unsafeUnlinedText :: HasCallStack => Text -> UnlinedText
unsafeUnlinedText Text
txt =
  if Char
'\n' Char -> Text -> Bool
`T.elem` Text
txt
    then String -> UnlinedText
forall a. HasCallStack => String -> a
error (String -> UnlinedText) -> String -> UnlinedText
forall a b. (a -> b) -> a -> b
$ String
"Unwanted newline in text: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
txt
    else Text -> UnlinedText
UnsafeUnlinedText Text
txt

-- NOTE: [Text Line Concatenation]
--
-- Normally, we log multiple newlines separately. However in at least one
-- case, we want a single log: final error message. Why? Because we want
-- exactly one [Success]/[Error] log, so if we have multiple stderr lines,
-- we need to combine these into a single log.
--
-- We have a choice on concatenation. We choose whitespace as the delimiter,
-- as newlines:
--
-- 1. Will get stripped during formatting (happens after this is called).
-- 2. Even if we special case to avoid 1, newlines probably won't look good
--    in the final output.
toText :: List UnlinedText -> Text
toText :: [UnlinedText] -> Text
toText = Text -> [Text] -> Text
T.intercalate Text
" " ([Text] -> Text)
-> ([UnlinedText] -> [Text]) -> [UnlinedText] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnlinedText -> Text) -> [UnlinedText] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic' A_Getter NoIx UnlinedText Text -> UnlinedText -> Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx UnlinedText Text
#unUnlinedText)

-- | Concats via 'toText'.
concat :: List UnlinedText -> UnlinedText
concat :: [UnlinedText] -> UnlinedText
concat = Text -> UnlinedText
UnsafeUnlinedText (Text -> UnlinedText)
-> ([UnlinedText] -> Text) -> [UnlinedText] -> UnlinedText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UnlinedText] -> Text
toText

intercalate :: UnlinedText -> List UnlinedText -> UnlinedText
intercalate :: UnlinedText -> [UnlinedText] -> UnlinedText
intercalate (UnsafeUnlinedText Text
d) =
  Text -> UnlinedText
UnsafeUnlinedText
    (Text -> UnlinedText)
-> ([UnlinedText] -> Text) -> [UnlinedText] -> UnlinedText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
d
    ([Text] -> Text)
-> ([UnlinedText] -> [Text]) -> [UnlinedText] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnlinedText -> Text) -> [UnlinedText] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic' A_Getter NoIx UnlinedText Text -> UnlinedText -> Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx UnlinedText Text
#unUnlinedText)

-- | Lifts a 'Text' function to 'UnlinedText'. Very unsafe in that we do not
-- check for errors i.e. if the parameter function introduces any newlines,
-- then this will silently succeed. This exists for performance.
reallyUnsafeLiftUnlined :: (Text -> Text) -> UnlinedText -> UnlinedText
reallyUnsafeLiftUnlined :: (Text -> Text) -> UnlinedText -> UnlinedText
reallyUnsafeLiftUnlined Text -> Text
f (UnsafeUnlinedText Text
t) = Text -> UnlinedText
UnsafeUnlinedText (Text -> Text
f Text
t)