-- SPDX-FileCopyrightText: 2021 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

{- |
String interpolation quasi-quoters. The most basic version is 'i', it returns anything that
has a 'Fmt.FromBuilder' instance: 'Text', 'ByteString', 'String', 'Builder'.

In some cases, it is more convenient to return a lazy @Text@ 'Builder', in that case 'ib', which
returns a non-polymorphic result, can be helpful, for instance, if you want to use one interpolated
string inside another one. Using 'Builder' is also more efficient in this case.

>>> let splice = [i|some text|]
>>> [i|larger text with #{splice}|] :: Text
...
... error:
... Ambiguous type variable ...
...

>>> let splice = [ib|some text|]
>>> [i|larger text with #{splice}|] :: Text
"larger text with some text"

There are also unindenting versions, i.e. those stripping the longest common indentation from each
line (note those do not consider indentation inside splices!), and trimming versions, i.e.
those that remove whitespace-only lines from beginning and end of the quote.

The mnemonic is @i@nterpolate @t@rimming @u@nindenting returning @b@uilder, i.e. 'itub' is
the trimming, unindenting version returning 'Builder'.

Versions not interpreting Haskell escape sequences additionally start with @l@, e.g. 'litu' is
@l@iteral @i@nterpolation @t@trimming @u@nindenting.

>>> [i|\955\x1F600\\|]
λ😀\

>>> [li|\955\x1F600\\|]
\955\x1F600\\

Splices are specified in the form @#{variableName}@. Note that expressions are not supported.
You can add @\@ before @#@, e.g. @\#{variableName}@, to interpret it as literal text. All the usual
Haskell string escapes also work, unless using "literal" versions. A warning will be issued if an
escape is not recognized, however the code will still compile, ignoring the backslash, e.g.
@\{@ will be treated as @{@.

All splices will be indented exactly to their column position in the original text, e.g.

>>> let splice = "multi\nline" :: Text
>>> [i|Some text #{splice}|]
Some text multi
          line

Multi-line splices will not automatically add any newlines after them, be mindful of that:

>>> let splice = "multi\nline" :: Text
>>> [i|Some text #{splice} trailing text|]
Some text multi
          line trailing text

If you wish to avoid that, either include the final newline in the splice explicitly (but be aware
that indentation of the trailing text won't be auto-adjusted, not even the leading spaces are
removed!), or include it in the quote:

>>> let splice = "multi\nline" :: Text
>>> :{
[itu|
  Some text #{splice}
  trailing text
  |]
:}
Some text multi
          line
trailing text

>>> let splice = "multi\nline\n" :: Text
>>> :{
[itu|
  Some text
    Some indented text #{splice} trailing text
  |]
:}
Some text
  Some indented text multi
                     line
 trailing text

Empty lines are never indented:

>>> let splice = "multi\n\nline" :: Text
>>> :{
print [itu|
  Some text #{splice}
  |]
:}
"Some text multi\n\n          line"

Unindenting versions will drop the first newline if the first line is empty, i.e.

>>> :{
print [iu|
There will be no leading newline here, but there will be a trailing one.
|]
:}
"There will be no leading newline here, but there will be a trailing one.\n"

but

>>> :{
print [iu|There will be a newline
here
|]
:}
"There will be a newline\nhere\n"

Unindent does not consider empty lines for finding common indentation, but it does consider
whitespace-only lines. As a result, one can control overall indentation by the indentation of the
last line:

>>> :{
let splice = "multi\nline" :: Text
in [itu|
    Some text #{splice}
    trailing text
  |]
:}
  Some text multi
            line
  trailing text
-}
module Morley.Util.Interpolate (
    i
  , ib
  , iu
  , iub
  , it
  , itb
  , itu
  , itub
  , li
  , lib
  , liu
  , liub
  , lit
  , litb
  , litu
  , litub
  ) where

import Prelude hiding (lift)

import Data.Char (isSpace)
import qualified Data.List as List
import qualified Data.Set as S
import Data.Text.Internal.Builder (Builder, fromLazyText, toLazyText)
import qualified Data.Text.Lazy as TL
import Fmt (build, fmt)
import Language.Haskell.TH (Exp, Q, lookupValueName, reportWarning, varE)
import Language.Haskell.TH.Quote (QuasiQuoter(..))
import Text.ParserCombinators.ReadP (readP_to_S)
import Text.Read.Lex (lexChar)

-- | Datatype encoding transformations we apply to a quoter input and output.
-- Note the order is important! We first unescape, then unindent, then trim.
data Transformation
  = Unescaping
  | Unindenting
  | Trimming
  | Polymorphic
  deriving stock (Transformation -> Transformation -> Bool
(Transformation -> Transformation -> Bool)
-> (Transformation -> Transformation -> Bool) -> Eq Transformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transformation -> Transformation -> Bool
$c/= :: Transformation -> Transformation -> Bool
== :: Transformation -> Transformation -> Bool
$c== :: Transformation -> Transformation -> Bool
Eq, Eq Transformation
Eq Transformation
-> (Transformation -> Transformation -> Ordering)
-> (Transformation -> Transformation -> Bool)
-> (Transformation -> Transformation -> Bool)
-> (Transformation -> Transformation -> Bool)
-> (Transformation -> Transformation -> Bool)
-> (Transformation -> Transformation -> Transformation)
-> (Transformation -> Transformation -> Transformation)
-> Ord Transformation
Transformation -> Transformation -> Bool
Transformation -> Transformation -> Ordering
Transformation -> Transformation -> Transformation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Transformation -> Transformation -> Transformation
$cmin :: Transformation -> Transformation -> Transformation
max :: Transformation -> Transformation -> Transformation
$cmax :: Transformation -> Transformation -> Transformation
>= :: Transformation -> Transformation -> Bool
$c>= :: Transformation -> Transformation -> Bool
> :: Transformation -> Transformation -> Bool
$c> :: Transformation -> Transformation -> Bool
<= :: Transformation -> Transformation -> Bool
$c<= :: Transformation -> Transformation -> Bool
< :: Transformation -> Transformation -> Bool
$c< :: Transformation -> Transformation -> Bool
compare :: Transformation -> Transformation -> Ordering
$ccompare :: Transformation -> Transformation -> Ordering
$cp1Ord :: Eq Transformation
Ord, Int -> Transformation
Transformation -> Int
Transformation -> [Transformation]
Transformation -> Transformation
Transformation -> Transformation -> [Transformation]
Transformation
-> Transformation -> Transformation -> [Transformation]
(Transformation -> Transformation)
-> (Transformation -> Transformation)
-> (Int -> Transformation)
-> (Transformation -> Int)
-> (Transformation -> [Transformation])
-> (Transformation -> Transformation -> [Transformation])
-> (Transformation -> Transformation -> [Transformation])
-> (Transformation
    -> Transformation -> Transformation -> [Transformation])
-> Enum Transformation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Transformation
-> Transformation -> Transformation -> [Transformation]
$cenumFromThenTo :: Transformation
-> Transformation -> Transformation -> [Transformation]
enumFromTo :: Transformation -> Transformation -> [Transformation]
$cenumFromTo :: Transformation -> Transformation -> [Transformation]
enumFromThen :: Transformation -> Transformation -> [Transformation]
$cenumFromThen :: Transformation -> Transformation -> [Transformation]
enumFrom :: Transformation -> [Transformation]
$cenumFrom :: Transformation -> [Transformation]
fromEnum :: Transformation -> Int
$cfromEnum :: Transformation -> Int
toEnum :: Int -> Transformation
$ctoEnum :: Int -> Transformation
pred :: Transformation -> Transformation
$cpred :: Transformation -> Transformation
succ :: Transformation -> Transformation
$csucc :: Transformation -> Transformation
Enum, Transformation
Transformation -> Transformation -> Bounded Transformation
forall a. a -> a -> Bounded a
maxBound :: Transformation
$cmaxBound :: Transformation
minBound :: Transformation
$cminBound :: Transformation
Bounded)

-- | A 'Set' of 'Transformation'
type Transformations = Set Transformation

-- | Actual quasi-quoters
i, ib, iu, iub, it, itb, itu, itub, li, lib, liu, liub, lit, litb, litu, litub :: QuasiQuoter

-- | 'Transformations' singletons
trimming, unindenting, unescaping, polymorphic :: Transformations
trimming :: Transformations
trimming = Transformation -> Transformations
forall a. a -> Set a
S.singleton Transformation
Trimming
unindenting :: Transformations
unindenting = Transformation -> Transformations
forall a. a -> Set a
S.singleton Transformation
Unindenting
unescaping :: Transformations
unescaping = Transformation -> Transformations
forall a. a -> Set a
S.singleton Transformation
Unescaping
polymorphic :: Transformations
polymorphic = Transformation -> Transformations
forall a. a -> Set a
S.singleton Transformation
Polymorphic

lib :: QuasiQuoter
lib = Transformations -> QuasiQuoter
mkQuoter Transformations
forall a. Monoid a => a
mempty
liub :: QuasiQuoter
liub = Transformations -> QuasiQuoter
mkQuoter Transformations
unindenting
litb :: QuasiQuoter
litb = Transformations -> QuasiQuoter
mkQuoter Transformations
trimming
litub :: QuasiQuoter
litub = Transformations -> QuasiQuoter
mkQuoter (Transformations -> QuasiQuoter) -> Transformations -> QuasiQuoter
forall a b. (a -> b) -> a -> b
$ Transformations
trimming Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
unindenting

ib :: QuasiQuoter
ib = Transformations -> QuasiQuoter
mkQuoter Transformations
unescaping
iub :: QuasiQuoter
iub = Transformations -> QuasiQuoter
mkQuoter (Transformations -> QuasiQuoter) -> Transformations -> QuasiQuoter
forall a b. (a -> b) -> a -> b
$ Transformations
unindenting Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
unescaping
itb :: QuasiQuoter
itb = Transformations -> QuasiQuoter
mkQuoter (Transformations -> QuasiQuoter) -> Transformations -> QuasiQuoter
forall a b. (a -> b) -> a -> b
$ Transformations
trimming Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
unescaping
itub :: QuasiQuoter
itub = Transformations -> QuasiQuoter
mkQuoter (Transformations -> QuasiQuoter) -> Transformations -> QuasiQuoter
forall a b. (a -> b) -> a -> b
$ Transformations
trimming Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
unindenting Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
unescaping

li :: QuasiQuoter
li = Transformations -> QuasiQuoter
mkQuoter Transformations
polymorphic
liu :: QuasiQuoter
liu = Transformations -> QuasiQuoter
mkQuoter (Transformations -> QuasiQuoter) -> Transformations -> QuasiQuoter
forall a b. (a -> b) -> a -> b
$ Transformations
unindenting Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
polymorphic
lit :: QuasiQuoter
lit = Transformations -> QuasiQuoter
mkQuoter (Transformations -> QuasiQuoter) -> Transformations -> QuasiQuoter
forall a b. (a -> b) -> a -> b
$ Transformations
trimming Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
polymorphic
litu :: QuasiQuoter
litu = Transformations -> QuasiQuoter
mkQuoter (Transformations -> QuasiQuoter) -> Transformations -> QuasiQuoter
forall a b. (a -> b) -> a -> b
$ Transformations
trimming Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
unindenting Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
polymorphic

i :: QuasiQuoter
i = Transformations -> QuasiQuoter
mkQuoter (Transformations -> QuasiQuoter) -> Transformations -> QuasiQuoter
forall a b. (a -> b) -> a -> b
$ Transformations
unescaping Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
polymorphic
iu :: QuasiQuoter
iu = Transformations -> QuasiQuoter
mkQuoter (Transformations -> QuasiQuoter) -> Transformations -> QuasiQuoter
forall a b. (a -> b) -> a -> b
$ Transformations
unindenting Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
unescaping Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
polymorphic
it :: QuasiQuoter
it = Transformations -> QuasiQuoter
mkQuoter (Transformations -> QuasiQuoter) -> Transformations -> QuasiQuoter
forall a b. (a -> b) -> a -> b
$ Transformations
trimming Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
unescaping Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
polymorphic
itu :: QuasiQuoter
itu = Transformations -> QuasiQuoter
mkQuoter (Transformations -> QuasiQuoter) -> Transformations -> QuasiQuoter
forall a b. (a -> b) -> a -> b
$ Transformations
trimming Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
unindenting Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
unescaping Transformations -> Transformations -> Transformations
forall a. Semigroup a => a -> a -> a
<> Transformations
polymorphic

mkQuoter :: Transformations -> QuasiQuoter
mkQuoter :: Transformations -> QuasiQuoter
mkQuoter Transformations
ts = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp = (Element [Transformation] -> (String -> Q Exp) -> String -> Q Exp)
-> (String -> Q Exp) -> [Transformation] -> String -> Q Exp
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr Element [Transformation] -> (String -> Q Exp) -> String -> Q Exp
Transformation -> (String -> Q Exp) -> String -> Q Exp
go String -> Q Exp
makeBuilder ([Transformation] -> String -> Q Exp)
-> [Transformation] -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Transformations -> [Element Transformations]
forall t. Container t => t -> [Element t]
toList Transformations
ts
  , quotePat :: String -> Q Pat
quotePat = \String
_ -> String -> Q Pat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot be used at pattern position"
  , quoteType :: String -> Q Type
quoteType = \String
_ -> String -> Q Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot be used at type position"
  , quoteDec :: String -> Q [Dec]
quoteDec = \String
_ -> String -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot be used as declaration"
  }
  where
    go :: Transformation -> (String -> Q Exp) -> String -> Q Exp
go Transformation
Unescaping  String -> Q Exp
f = String -> Q Exp
f (String -> Q Exp) -> (String -> Q String) -> String -> Q Exp
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> Q String
unescape
    go Transformation
Unindenting String -> Q Exp
f = String -> Q Exp
f (String -> Q Exp) -> (String -> String) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
unindent (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropLeadingNewline
    go Transformation
Trimming    String -> Q Exp
f = String -> Q Exp
f (String -> Q Exp) -> (String -> String) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
trim
    go Transformation
Polymorphic String -> Q Exp
f = \String
s -> [| fmt $(f s) |]

unescape :: String -> Q String
unescape :: String -> Q String
unescape (Char
'\\':Char
'#':String
xs) = (Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'#'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> Q String -> Q String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q String
unescape String
xs
unescape xs :: String
xs@(Char
'\\':Char
c:String
cs) = case ReadP Char -> ReadS Char
forall a. ReadP a -> ReadS a
readP_to_S ReadP Char
lexChar String
xs of
  (Char
ch, String
rest):[(Char, String)]
_ -> (Char
ch Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> Q String -> Q String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q String
unescape String
rest
  [] -> do
    String -> Q ()
reportWarning (String -> Q ()) -> String -> Q ()
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized escape sequence near '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) String
xs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"
    (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> Q String -> Q String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q String
unescape String
cs
unescape (Char
c:String
cs) = (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> Q String -> Q String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q String
unescape String
cs
unescape [] = String -> Q String
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

makeBuilder :: String -> Q Exp
makeBuilder :: String -> Q Exp
makeBuilder = Builder -> String -> Q Exp
go Builder
forall a. Monoid a => a
mempty
  where
    go :: Builder -> String -> Q Exp
go Builder
tacc (Char
'\\':Char
'#':String
xs) = Builder -> String -> Q Exp
go (Builder
tacc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"#") String
xs
    go Builder
tacc (Char
'#':Char
'{':String
xs)
      | (String
expr, Char
'}':String
ys) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'}') String
xs
      = String -> Q (Maybe Name)
lookupValueName String
expr Q (Maybe Name) -> (Maybe Name -> Q Exp) -> Q Exp
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just Name
valueName ->
            let txt :: Text
txt = Builder -> Text
forall b. FromBuilder b => Builder -> b
fmt Builder
tacc
                ls :: NonEmpty Text
ls = (Char -> Bool) -> Text -> NonEmpty Text
splitTextLazy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') Text
txt
                indent :: Int
indent = Text -> Int
forall t. Container t => t -> Int
length (Text -> Int) -> (NonEmpty Text -> Text) -> NonEmpty Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> Text
forall a. NonEmpty a -> a
last (NonEmpty Text -> Int) -> NonEmpty Text -> Int
forall a b. (a -> b) -> a -> b
$ NonEmpty Text
ls
            in [| build txt <> indentF'' indent (build $(varE valueName)) <> $(go mempty ys) |]
          Maybe Name
Nothing -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"Variable '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' is not in scope"
    go Builder
tacc (Char
c:String
cs) = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span (Element String -> String -> Bool
forall t. (Container t, Eq (Element t)) => Element t -> t -> Bool
`notElem` [Char
'\\', Char
'#']) String
cs of
      (String
str, String
rest) -> Builder -> String -> Q Exp
go (Builder
tacc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
forall p. Buildable p => p -> Builder
build (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
str)) String
rest
    go Builder
tacc [] = let txt :: Text
txt = Builder -> Text
forall b. FromBuilder b => Builder -> b
fmt @Text Builder
tacc in [| build txt |]

-- | A version of @Fmt.indentF'@ that doesn't indent the first line, and keeps the final line break
-- intact.
indentF'' :: Int -> Builder -> Builder
indentF'' :: Int -> Builder -> Builder
indentF'' Int
indent Builder
bld = case (Char -> Bool) -> Text -> NonEmpty Text
splitTextLazy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') (Text -> NonEmpty Text) -> Text -> NonEmpty Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
toLazyText Builder
bld of
  (Text
x :| [Text]
xs) -> Text -> Builder
fromLazyText (Text -> Builder) -> ([Text] -> Text) -> [Text] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
TL.intercalate Text
"\n" ([Text] -> Builder) -> [Text] -> Builder
forall a b. (a -> b) -> a -> b
$ Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Text
addIndent [Text]
xs
  where
    addIndent :: Text -> Text
addIndent Text
str | Text -> Bool
forall t. Container t => t -> Bool
null Text
str = Text
str
                  | Bool
otherwise = Text
spaces Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str
    spaces :: Text
spaces = Int64 -> Text -> Text
TL.replicate (Int -> Int64
forall a b.
(Integral a, Integral b, IsIntSubType a b ~ 'True) =>
a -> b
fromIntegral Int
indent) Text
" "

splitTextLazy :: (Char -> Bool) -> TL.Text -> NonEmpty TL.Text
splitTextLazy :: (Char -> Bool) -> Text -> NonEmpty Text
splitTextLazy Char -> Bool
p Text
t = case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Text] -> Maybe (NonEmpty Text))
-> [Text] -> Maybe (NonEmpty Text)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
TL.split Char -> Bool
p Text
t of
  Just NonEmpty Text
ne -> NonEmpty Text
ne
  Maybe (NonEmpty Text)
Nothing -> Text -> NonEmpty Text
forall a. HasCallStack => Text -> a
error Text
"Morley.Util.Interpolate.splitTextLazy: the impossible happened"

dropLeadingNewline :: String -> String
dropLeadingNewline :: String -> String
dropLeadingNewline (Char
'\n':String
xs) = String
xs
dropLeadingNewline String
xs = String
xs

unindent :: String -> String
unindent :: String -> String
unindent String
s =
  case [String] -> Maybe (NonEmpty String)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall t. Container t => t -> Bool
null) [String]
ls) of
    Just NonEmpty String
ne ->
      let minIndent :: Int
minIndent = NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
minimum (NonEmpty Int -> Int) -> NonEmpty Int -> Int
forall a b. (a -> b) -> a -> b
$ String -> Int
indentOf (String -> Int) -> NonEmpty String -> NonEmpty Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty String
ne
      -- See Note [lines/unlines] below about the use of 'intercalate'
      in String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
minIndent (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
ls
    Maybe (NonEmpty String)
Nothing -> String
s
  where
    ls :: [String]
ls = (Char -> Bool) -> String -> [String]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') String
s
    indentOf :: String -> Int
indentOf = String -> Int
forall t. Container t => t -> Int
length (String -> Int) -> (String -> String) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')

-- See Note [lines/unlines] below about the use of this function
split :: (Char -> Bool) -> String -> [String]
split :: (Char -> Bool) -> String -> [String]
split Char -> Bool
cond String
s = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
cond String
s of
  (String
pfx, Char
_:String
suf) -> String
pfx String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Char -> Bool) -> String -> [String]
split Char -> Bool
cond String
suf
  (String
pfx, String
"") -> [String
pfx]

trim :: String -> String
trim :: String -> String
trim = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
List.dropWhileEnd ((Element String -> Bool) -> String -> Bool
forall t. Container t => (Element t -> Bool) -> t -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '))
     -- See Note [lines/unlines] below about the use of 'intercalate'
     ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Element String -> Bool) -> String -> Bool
forall t. Container t => (Element t -> Bool) -> t -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> [String]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n')

{- Note [lines/unlines]
   ~~~~~~~~~~~~~~~~~~~~

lines/unlines don't actually satisfy our requirements here due to
some edge case behaviour.

First of all, `lines` and `unlines` aren't strictly speaking inverse
of each other: `unlines` always adds a trailing newline. Consider:

>>> unlines . lines $ "hello\nworld"
"hello\nworld\n"

Furthermore, `lines` itself does "gobble" the trailing empty line, consider:

>>> lines $ "hello\nworld\n"
["hello","world"]

We actually need this to be `["hello","world",""]` for the unindenting
algorithm to work correctly (i.e. not unindent anything if the last indent is 0),
but that doesn't work with `lines` (also we either lose a trailing newline
or get an extra one with `unlines`). I could use `lines` with `trim`,
but for consistency chose not to.

Long story short, I use `split (=='\n')` and `Text.Lazy.split (=='\n')`
to get a list of lines, and `intercalate "\n"` to glue them back.
This has the behaviour we need.

- @lierdakil

-}