{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies      #-}
module Ide.PluginUtils
  ( -- * LSP Range manipulation functions
    normalize,
    extendNextLine,
    extendLineStart,
    WithDeletions(..),
    getProcessID,
    makeDiffTextEdit,
    makeDiffTextEditAdditive,
    diffText,
    diffText',
    pluginDescToIdePlugins,
    idePluginsToPluginDesc,
    responseError,
    getClientConfig,
    getPluginConfig,
    configForPlugin,
    pluginEnabled,
    extractRange,
    fullRange,
    mkLspCommand,
    mkLspCmdId,
    getPid,
    allLspCmdIds,
    allLspCmdIds',
    installSigUsr1Handler,
    subRange,
    positionInRange,
    usePropertyLsp,
    getNormalizedFilePath,
    pluginResponse,
    handleMaybe,
    handleMaybeM,
    throwPluginError,
    unescape,
    )
where


import           Control.Arrow                   ((&&&))
import           Control.Monad.Extra             (maybeM)
import           Control.Monad.Trans.Class       (lift)
import           Control.Monad.Trans.Except      (ExceptT, runExceptT, throwE)
import           Data.Algorithm.Diff
import           Data.Algorithm.DiffOutput
import           Data.Bifunctor                  (Bifunctor (first))
import           Data.Char                       (isPrint, showLitChar)
import           Data.Functor                    (void)
import qualified Data.HashMap.Strict             as H
import           Data.String                     (IsString (fromString))
import qualified Data.Text                       as T
import           Data.Void                       (Void)
import           Ide.Plugin.Config
import           Ide.Plugin.Properties
import           Ide.Types
import           Language.LSP.Server
import           Language.LSP.Types              hiding
                                                 (SemanticTokenAbsolute (length, line),
                                                  SemanticTokenRelative (length),
                                                  SemanticTokensEdit (_start))
import qualified Language.LSP.Types              as J
import           Language.LSP.Types.Capabilities
import qualified Text.Megaparsec                 as P
import qualified Text.Megaparsec.Char            as P
import qualified Text.Megaparsec.Char.Lexer      as P

-- ---------------------------------------------------------------------

-- | Extend to the line below and above to replace newline character.
--
-- >>> normalize (Range (Position 5 5) (Position 5 10))
-- Range (Position 5 0) (Position 6 0)
normalize :: Range -> Range
normalize :: Range -> Range
normalize = Range -> Range
extendLineStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Range
extendNextLine

-- | Extend 'Range' to the start of the next line.
--
-- >>> extendNextLine (Range (Position 5 5) (Position 5 10))
-- Range (Position 5 5) (Position 6 0)
extendNextLine :: Range -> Range
extendNextLine :: Range -> Range
extendNextLine (Range Position
s (Position UInt
el UInt
_)) =
  Position -> Position -> Range
Range Position
s (UInt -> UInt -> Position
Position (UInt
el forall a. Num a => a -> a -> a
+ UInt
1) UInt
0)

-- | Extend 'Range' to the start of the current line.
--
-- >>> extendLineStart (Range (Position 5 5) (Position 5 10))
-- Range (Position 5 0) (Position 5 10)
extendLineStart :: Range -> Range
extendLineStart :: Range -> Range
extendLineStart (Range (Position UInt
sl UInt
_) Position
e) =
  Position -> Position -> Range
Range (UInt -> UInt -> Position
Position UInt
sl UInt
0) Position
e

-- ---------------------------------------------------------------------

data WithDeletions = IncludeDeletions | SkipDeletions
  deriving WithDeletions -> WithDeletions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithDeletions -> WithDeletions -> Bool
$c/= :: WithDeletions -> WithDeletions -> Bool
== :: WithDeletions -> WithDeletions -> Bool
$c== :: WithDeletions -> WithDeletions -> Bool
Eq

-- | Generate a 'WorkspaceEdit' value from a pair of source Text
diffText :: ClientCapabilities -> (Uri,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit
diffText :: ClientCapabilities
-> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText ClientCapabilities
clientCaps (Uri, Text)
old Text
new WithDeletions
withDeletions =
  let
    supports :: Bool
supports = ClientCapabilities -> Bool
clientSupportsDocumentChanges ClientCapabilities
clientCaps
  in Bool -> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText' Bool
supports (Uri, Text)
old Text
new WithDeletions
withDeletions

makeDiffTextEdit :: T.Text -> T.Text -> List TextEdit
makeDiffTextEdit :: Text -> Text -> List TextEdit
makeDiffTextEdit Text
f1 Text
f2 = Text -> Text -> WithDeletions -> List TextEdit
diffTextEdit Text
f1 Text
f2 WithDeletions
IncludeDeletions

makeDiffTextEditAdditive :: T.Text -> T.Text -> List TextEdit
makeDiffTextEditAdditive :: Text -> Text -> List TextEdit
makeDiffTextEditAdditive Text
f1 Text
f2 = Text -> Text -> WithDeletions -> List TextEdit
diffTextEdit Text
f1 Text
f2 WithDeletions
SkipDeletions

diffTextEdit :: T.Text -> T.Text -> WithDeletions -> List TextEdit
diffTextEdit :: Text -> Text -> WithDeletions -> List TextEdit
diffTextEdit Text
fText Text
f2Text WithDeletions
withDeletions = forall a. [a] -> List a
J.List [TextEdit]
r
  where
    r :: [TextEdit]
r = forall a b. (a -> b) -> [a] -> [b]
map DiffOperation LineRange -> TextEdit
diffOperationToTextEdit [DiffOperation LineRange]
diffOps
    d :: [Diff [String]]
d = forall a. Eq a => [a] -> [a] -> [Diff [a]]
getGroupedDiff (String -> [String]
lines forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
fText) (String -> [String]
lines forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
f2Text)

    diffOps :: [DiffOperation LineRange]
diffOps = forall a. (a -> Bool) -> [a] -> [a]
filter (\DiffOperation LineRange
x -> (WithDeletions
withDeletions forall a. Eq a => a -> a -> Bool
== WithDeletions
IncludeDeletions) Bool -> Bool -> Bool
|| Bool -> Bool
not (forall {a}. DiffOperation a -> Bool
isDeletion DiffOperation LineRange
x))
                     ([Diff [String]] -> [DiffOperation LineRange]
diffToLineRanges [Diff [String]]
d)

    isDeletion :: DiffOperation a -> Bool
isDeletion (Deletion a
_ Int
_) = Bool
True
    isDeletion DiffOperation a
_              = Bool
False


    diffOperationToTextEdit :: DiffOperation LineRange -> J.TextEdit
    diffOperationToTextEdit :: DiffOperation LineRange -> TextEdit
diffOperationToTextEdit (Change LineRange
fm LineRange
to) = Range -> Text -> TextEdit
J.TextEdit Range
range Text
nt
      where
        range :: Range
range = LineRange -> Range
calcRange LineRange
fm
        nt :: Text
nt = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ LineRange -> [String]
lrContents LineRange
to

    {-
      In order to replace everything including newline characters,
      the end range should extend below the last line. From the specification:
      "If you want to specify a range that contains a line including
      the line ending character(s) then use an end position denoting
      the start of the next line"
    -}
    diffOperationToTextEdit (Deletion (LineRange (Int
sl, Int
el) [String]
_) Int
_) = Range -> Text -> TextEdit
J.TextEdit Range
range Text
""
      where
        range :: Range
range = Position -> Position -> Range
J.Range (UInt -> UInt -> Position
J.Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
sl forall a. Num a => a -> a -> a
- Int
1) UInt
0)
                        (UInt -> UInt -> Position
J.Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
el) UInt
0)

    diffOperationToTextEdit (Addition LineRange
fm Int
l) = Range -> Text -> TextEdit
J.TextEdit Range
range Text
nt
    -- fm has a range wrt to the changed file, which starts in the current file at l + 1
    -- So the range has to be shifted to start at l + 1
      where
        range :: Range
range = Position -> Position -> Range
J.Range (UInt -> UInt -> Position
J.Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) UInt
0)
                        (UInt -> UInt -> Position
J.Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) UInt
0)
        nt :: Text
nt = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ LineRange -> [String]
lrContents LineRange
fm


    calcRange :: LineRange -> Range
calcRange LineRange
fm = Position -> Position -> Range
J.Range Position
s Position
e
      where
        sl :: Int
sl = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ LineRange -> (Int, Int)
lrNumbers LineRange
fm
        sc :: UInt
sc = UInt
0
        s :: Position
s = UInt -> UInt -> Position
J.Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
sl forall a. Num a => a -> a -> a
- Int
1) UInt
sc -- Note: zero-based lines
        el :: Int
el = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ LineRange -> (Int, Int)
lrNumbers LineRange
fm
        ec :: UInt
ec = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ LineRange -> [String]
lrContents LineRange
fm
        e :: Position
e = UInt -> UInt -> Position
J.Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
el forall a. Num a => a -> a -> a
- Int
1) UInt
ec  -- Note: zero-based lines


-- | A pure version of 'diffText' for testing
diffText' :: Bool -> (Uri,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit
diffText' :: Bool -> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText' Bool
supports (Uri
f,Text
fText) Text
f2Text WithDeletions
withDeletions  =
  if Bool
supports
    then Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just List DocumentChange
docChanges) forall a. Maybe a
Nothing
    else Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit (forall a. a -> Maybe a
Just WorkspaceEditMap
h) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  where
    diff :: List TextEdit
diff = Text -> Text -> WithDeletions -> List TextEdit
diffTextEdit Text
fText Text
f2Text WithDeletions
withDeletions
    h :: WorkspaceEditMap
h = forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Uri
f List TextEdit
diff
    docChanges :: List DocumentChange
docChanges = forall a. [a] -> List a
J.List [forall a b. a -> a |? b
InL TextDocumentEdit
docEdit]
    docEdit :: TextDocumentEdit
docEdit = VersionedTextDocumentIdentifier
-> List (TextEdit |? AnnotatedTextEdit) -> TextDocumentEdit
J.TextDocumentEdit (Uri -> TextDocumentVersion -> VersionedTextDocumentIdentifier
J.VersionedTextDocumentIdentifier Uri
f (forall a. a -> Maybe a
Just Int32
0)) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> a |? b
InL List TextEdit
diff

-- ---------------------------------------------------------------------

clientSupportsDocumentChanges :: ClientCapabilities -> Bool
clientSupportsDocumentChanges :: ClientCapabilities -> Bool
clientSupportsDocumentChanges ClientCapabilities
caps =
  let ClientCapabilities Maybe WorkspaceClientCapabilities
mwCaps Maybe TextDocumentClientCapabilities
_ Maybe WindowClientCapabilities
_ Maybe GeneralClientCapabilities
_ Maybe Object
_ = ClientCapabilities
caps
      supports :: Maybe Bool
supports = do
        WorkspaceClientCapabilities
wCaps <- Maybe WorkspaceClientCapabilities
mwCaps
        WorkspaceEditClientCapabilities Maybe Bool
mDc Maybe (List ResourceOperationKind)
_ Maybe FailureHandlingKind
_ Maybe Bool
_ Maybe WorkspaceEditChangeAnnotationClientCapabilities
_ <- WorkspaceClientCapabilities
-> Maybe WorkspaceEditClientCapabilities
_workspaceEdit WorkspaceClientCapabilities
wCaps
        Maybe Bool
mDc
  in
    forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== Maybe Bool
supports

-- ---------------------------------------------------------------------

pluginDescToIdePlugins :: [PluginDescriptor ideState] -> IdePlugins ideState
pluginDescToIdePlugins :: forall ideState. [PluginDescriptor ideState] -> IdePlugins ideState
pluginDescToIdePlugins = forall ideState. [PluginDescriptor ideState] -> IdePlugins ideState
IdePlugins

idePluginsToPluginDesc :: IdePlugins ideState -> [PluginDescriptor ideState]
idePluginsToPluginDesc :: forall ideState. IdePlugins ideState -> [PluginDescriptor ideState]
idePluginsToPluginDesc (IdePlugins [PluginDescriptor ideState]
pp) = [PluginDescriptor ideState]
pp

-- ---------------------------------------------------------------------
-- | Returns the current client configuration. It is not wise to permanently
-- cache the returned value of this function, as clients can at runtime change
-- their configuration.
--
getClientConfig :: MonadLsp Config m => m Config
getClientConfig :: forall (m :: * -> *). MonadLsp Config m => m Config
getClientConfig = forall config (m :: * -> *). MonadLsp config m => m config
getConfig

-- ---------------------------------------------------------------------

-- | Returns the current plugin configuration. It is not wise to permanently
-- cache the returned value of this function, as clients can change their
-- configuration at runtime.
getPluginConfig :: MonadLsp Config m => PluginDescriptor c -> m PluginConfig
getPluginConfig :: forall (m :: * -> *) c.
MonadLsp Config m =>
PluginDescriptor c -> m PluginConfig
getPluginConfig PluginDescriptor c
plugin = do
    Config
config <- forall (m :: * -> *). MonadLsp Config m => m Config
getClientConfig
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. Config -> PluginDescriptor c -> PluginConfig
configForPlugin Config
config PluginDescriptor c
plugin

-- ---------------------------------------------------------------------

-- | Returns the value of a property defined by the current plugin.
usePropertyLsp ::
  (HasProperty s k t r, MonadLsp Config m) =>
  KeyNameProxy s ->
  PluginDescriptor c ->
  Properties r ->
  m (ToHsType t)
usePropertyLsp :: forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]) (m :: * -> *) c.
(HasProperty s k t r, MonadLsp Config m) =>
KeyNameProxy s
-> PluginDescriptor c -> Properties r -> m (ToHsType t)
usePropertyLsp KeyNameProxy s
kn PluginDescriptor c
pId Properties r
p = do
  PluginConfig
config <- forall (m :: * -> *) c.
MonadLsp Config m =>
PluginDescriptor c -> m PluginConfig
getPluginConfig PluginDescriptor c
pId
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> Properties r -> Object -> ToHsType t
useProperty KeyNameProxy s
kn Properties r
p forall a b. (a -> b) -> a -> b
$ PluginConfig -> Object
plcConfig PluginConfig
config

-- ---------------------------------------------------------------------

extractRange :: Range -> T.Text -> T.Text
extractRange :: Range -> Text -> Text
extractRange (Range (Position UInt
sl UInt
_) (Position UInt
el UInt
_)) Text
s = Text
newS
  where focusLines :: [Text]
focusLines = forall a. Int -> [a] -> [a]
take (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ UInt
elforall a. Num a => a -> a -> a
-UInt
slforall a. Num a => a -> a -> a
+UInt
1) forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
sl) forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
s
        newS :: Text
newS = [Text] -> Text
T.unlines [Text]
focusLines

-- | Gets the range that covers the entire text
fullRange :: T.Text -> Range
fullRange :: Text -> Range
fullRange Text
s = Position -> Position -> Range
Range Position
startPos Position
endPos
  where startPos :: Position
startPos = UInt -> UInt -> Position
Position UInt
0 UInt
0
        endPos :: Position
endPos = UInt -> UInt -> Position
Position UInt
lastLine UInt
0
        {-
        In order to replace everything including newline characters,
        the end range should extend below the last line. From the specification:
        "If you want to specify a range that contains a line including
        the line ending character(s) then use an end position denoting
        the start of the next line"
        -}
        lastLine :: UInt
lastLine = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
s

subRange :: Range -> Range -> Bool
subRange :: Range -> Range -> Bool
subRange = Range -> Range -> Bool
isSubrangeOf

-- ---------------------------------------------------------------------

allLspCmdIds' :: T.Text -> IdePlugins ideState -> [T.Text]
allLspCmdIds' :: forall ideState. Text -> IdePlugins ideState -> [Text]
allLspCmdIds' Text
pid (IdePlugins [PluginDescriptor ideState]
ls) =
    forall ideState.
Text -> [(PluginId, [PluginCommand ideState])] -> [Text]
allLspCmdIds Text
pid forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall ideState. PluginDescriptor ideState -> PluginId
pluginId forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall ideState.
PluginDescriptor ideState -> [PluginCommand ideState]
pluginCommands) [PluginDescriptor ideState]
ls

allLspCmdIds :: T.Text -> [(PluginId, [PluginCommand ideState])] -> [T.Text]
allLspCmdIds :: forall ideState.
Text -> [(PluginId, [PluginCommand ideState])] -> [Text]
allLspCmdIds Text
pid [(PluginId, [PluginCommand ideState])]
commands = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PluginId, [PluginCommand ideState]) -> [Text]
go [(PluginId, [PluginCommand ideState])]
commands
  where
    go :: (PluginId, [PluginCommand ideState]) -> [Text]
go (PluginId
plid, [PluginCommand ideState]
cmds) = forall a b. (a -> b) -> [a] -> [b]
map (Text -> PluginId -> CommandId -> Text
mkLspCmdId Text
pid PluginId
plid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ideState. PluginCommand ideState -> CommandId
commandId) [PluginCommand ideState]
cmds


-- ---------------------------------------------------------------------

getNormalizedFilePath :: Monad m => Uri -> ExceptT String m NormalizedFilePath
getNormalizedFilePath :: forall (m :: * -> *).
Monad m =>
Uri -> ExceptT String m NormalizedFilePath
getNormalizedFilePath Uri
uri = forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe String
errMsg
        forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath
        forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
    where
        errMsg :: String
errMsg = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text
"Failed converting " forall a. Semigroup a => a -> a -> a
<> Uri -> Text
getUri Uri
uri forall a. Semigroup a => a -> a -> a
<> Text
" to NormalizedFilePath"

-- ---------------------------------------------------------------------
throwPluginError :: Monad m => String -> ExceptT String m b
throwPluginError :: forall (m :: * -> *) b. Monad m => String -> ExceptT String m b
throwPluginError = forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE

handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe :: forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe e
msg = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
msg) forall (m :: * -> *) a. Monad m => a -> m a
return

handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b
handleMaybeM :: forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM e
msg m (Maybe b)
act = forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM (forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
msg) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe b)
act

pluginResponse :: Monad m => ExceptT String m a -> m (Either ResponseError a)
pluginResponse :: forall (m :: * -> *) a.
Monad m =>
ExceptT String m a -> m (Either ResponseError a)
pluginResponse =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\String
msg -> ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InternalError (forall a. IsString a => String -> a
fromString String
msg) forall a. Maybe a
Nothing))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT

-- ---------------------------------------------------------------------

type TextParser = P.Parsec Void T.Text

-- | Unescape printable escape sequences within double quotes.
-- This is useful if you have to call 'show' indirectly, and it escapes some characters which you would prefer to
-- display as is.
unescape :: T.Text -> T.Text
unescape :: Text -> Text
unescape Text
input =
    case forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.runParser TextParser String
escapedTextParser String
"inline" Text
input of
        Left ParseErrorBundle Text Void
_     -> Text
input
        Right String
strs -> String -> Text
T.pack String
strs

-- | Parser for a string that contains double quotes. Returns unescaped string.
escapedTextParser :: TextParser String
escapedTextParser :: TextParser String
escapedTextParser = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many (TextParser String
outsideStringLiteral forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
P.<|> TextParser String
stringLiteral)
  where
    outsideStringLiteral :: TextParser String
    outsideStringLiteral :: TextParser String
outsideStringLiteral = forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.someTill (forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
P.anySingleBut Char
'"') (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead (forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
'"') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
P.<|> forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof))

    stringLiteral :: TextParser String
    stringLiteral :: TextParser String
stringLiteral = do
        String
inside <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
'"' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
P.charLiteral (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
'"')
        let f :: Char -> String
f Char
'"' = String
"\\\"" -- double quote should still be escaped
            -- Despite the docs, 'showLitChar' and 'showLitString' from 'Data.Char' DOES ESCAPE unicode printable
            -- characters. So we need to call 'isPrint' from 'Data.Char' manually.
            f Char
ch  = if Char -> Bool
isPrint Char
ch then [Char
ch] else Char -> ShowS
showLitChar Char
ch String
""
            inside' :: String
inside' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
f String
inside

        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String
"\"" forall a. Semigroup a => a -> a -> a
<> String
inside' forall a. Semigroup a => a -> a -> a
<> String
"\""