{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE QuasiQuotes #-}

module Ghcitui.Ghcid.ParseContext
    ( ParseContextOut (..)
    , ParseContextReturn (..)
    , NameBinding (..)
    , BindingValue (..)
    , parseContext
    , parseBreakResponse
    , parseBindings
    , parseShowBreaks
    , parseShowModules
    , isHistoryFailureMsg
    , cleanResponse
    , ParseError (..)
    ) where

import Prelude hiding (lines)

import Control.Applicative ((<|>))
import Control.Error
import Data.Array ((!))
import Data.String.Interpolate (i)
import qualified Data.Text as T
import Text.Regex.TDFA (MatchResult (..), (=~~))
import qualified Text.Regex.TDFA as Regex

import Ghcitui.Ghcid.ParseError (ParseError (..)) -- Re-export.
import qualified Ghcitui.Loc as Loc
import Ghcitui.NameBinding
import Ghcitui.Util

ghcidPrompt :: T.Text
ghcidPrompt :: Text
ghcidPrompt = Text
"#~GHCID-START~#"

-- | Output record datatype for 'parseContext'.
data ParseContextOut = ParseContextOut
    { ParseContextOut -> Text
func :: !T.Text
    , ParseContextOut -> [Char]
filepath :: !FilePath
    , ParseContextOut -> SourceRange
pcSourceRange :: !Loc.SourceRange
    }
    deriving (ParseContextOut -> ParseContextOut -> Bool
(ParseContextOut -> ParseContextOut -> Bool)
-> (ParseContextOut -> ParseContextOut -> Bool)
-> Eq ParseContextOut
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseContextOut -> ParseContextOut -> Bool
== :: ParseContextOut -> ParseContextOut -> Bool
$c/= :: ParseContextOut -> ParseContextOut -> Bool
/= :: ParseContextOut -> ParseContextOut -> Bool
Eq, Int -> ParseContextOut -> ShowS
[ParseContextOut] -> ShowS
ParseContextOut -> [Char]
(Int -> ParseContextOut -> ShowS)
-> (ParseContextOut -> [Char])
-> ([ParseContextOut] -> ShowS)
-> Show ParseContextOut
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseContextOut -> ShowS
showsPrec :: Int -> ParseContextOut -> ShowS
$cshow :: ParseContextOut -> [Char]
show :: ParseContextOut -> [Char]
$cshowList :: [ParseContextOut] -> ShowS
showList :: [ParseContextOut] -> ShowS
Show)

data ParseContextReturn = PCError ParseError | PCNoContext | PCContext ParseContextOut deriving (ParseContextReturn -> ParseContextReturn -> Bool
(ParseContextReturn -> ParseContextReturn -> Bool)
-> (ParseContextReturn -> ParseContextReturn -> Bool)
-> Eq ParseContextReturn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseContextReturn -> ParseContextReturn -> Bool
== :: ParseContextReturn -> ParseContextReturn -> Bool
$c/= :: ParseContextReturn -> ParseContextReturn -> Bool
/= :: ParseContextReturn -> ParseContextReturn -> Bool
Eq, Int -> ParseContextReturn -> ShowS
[ParseContextReturn] -> ShowS
ParseContextReturn -> [Char]
(Int -> ParseContextReturn -> ShowS)
-> (ParseContextReturn -> [Char])
-> ([ParseContextReturn] -> ShowS)
-> Show ParseContextReturn
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseContextReturn -> ShowS
showsPrec :: Int -> ParseContextReturn -> ShowS
$cshow :: ParseContextReturn -> [Char]
show :: ParseContextReturn -> [Char]
$cshowList :: [ParseContextReturn] -> ShowS
showList :: [ParseContextReturn] -> ShowS
Show)

-- | Parse the output from ":show context" for the interpreter state.
parseContext :: T.Text -> ParseContextReturn
parseContext :: Text -> ParseContextReturn
parseContext Text
contextText =
    case Text -> Either ParseError (Text, Text)
eInfoLine Text
contextText of
        Right (Text
func, Text
rest) ->
            let sourceRange :: SourceRange
sourceRange = Text -> SourceRange
parseSourceRange Text
rest
             in case Text -> Either ParseError [Char]
parseFile Text
rest of
                    Right [Char]
f -> ParseContextOut -> ParseContextReturn
PCContext (Text -> [Char] -> SourceRange -> ParseContextOut
ParseContextOut Text
func [Char]
f SourceRange
sourceRange)
                    Left ParseError
e -> ParseError -> ParseContextReturn
PCError ParseError
e
        Left (ParseError Text
e) ->
            let contextTextLines :: [Text]
contextTextLines = Text -> [Text]
T.lines Text
contextText
             in if (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"", Text
"()"]) [Text]
contextTextLines
                    then ParseContextReturn
PCNoContext
                    else ParseError -> ParseContextReturn
PCError (Text -> ParseError
ParseError [i|parsing context: #{e}|])

parseFile :: T.Text -> Either ParseError FilePath
parseFile :: Text -> Either ParseError [Char]
parseFile Text
s
    | Just MatchResult Text
mr <- Text
s Text -> Text -> Maybe (MatchResult Text)
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ (Text
"^[ \t]*([^:]*):" :: T.Text) = [Char] -> Either ParseError [Char]
forall a b. b -> Either a b
Right (Text -> [Char]
T.unpack (MatchResult Text -> Array Int Text
forall a. MatchResult a -> Array Int a
mrSubs MatchResult Text
mr Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
1))
    | Bool
otherwise = ParseError -> Either ParseError [Char]
forall a b. a -> Either a b
Left (Text -> ParseError
ParseError [i|Could not parse file from: '#{s}'|])

-- | Parse a source range structure into a SourceRange object.
parseSourceRange :: T.Text -> Loc.SourceRange
parseSourceRange :: Text -> SourceRange
parseSourceRange Text
s
    -- Matches (12,34)-(56,78) ... (line 12, column 34 to line 56, column 78)
    | Just MatchResult Text
mr <- Text -> Maybe (MatchResult Text)
matches Text
"\\(([0-9]+),([0-9]+)\\)-\\(([0-9]+),([0-9]+)\\)" = MatchResult Text -> SourceRange
fullRange MatchResult Text
mr
    -- Matches 12:34-56 ... (line 12, columns 34 to 56)
    | Just MatchResult Text
mr <- Text -> Maybe (MatchResult Text)
matches Text
"([0-9]+):([0-9]+)-([0-9]+)" = MatchResult Text -> SourceRange
lineColRange MatchResult Text
mr
    -- Matches 12:34
    | Just MatchResult Text
mr <- Text -> Maybe (MatchResult Text)
matches Text
"([0-9]+):([0-9]+)" = MatchResult Text -> SourceRange
lineColSingle MatchResult Text
mr
    -- Matches 12
    | Just MatchResult Text
mr <- Text -> Maybe (MatchResult Text)
matches Text
"([0-9]+)" = MatchResult Text -> SourceRange
onlyLine MatchResult Text
mr
    | Bool
otherwise = SourceRange
Loc.unknownSourceRange
  where
    matches :: T.Text -> Maybe (MatchResult T.Text)
    matches :: Text -> Maybe (MatchResult Text)
matches Text
reg = Text
s Text -> Text -> Maybe (MatchResult Text)
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ Text
reg

    unpackRead :: (Read a) => MatchResult T.Text -> Int -> Maybe a
    unpackRead :: forall a. Read a => MatchResult Text -> Int -> Maybe a
unpackRead MatchResult Text
mr Int
idx = [Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMay (Text -> [Char]
T.unpack (MatchResult Text -> Array Int Text
forall a. MatchResult a -> Array Int a
mrSubs MatchResult Text
mr Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
idx))

    fullRange :: MatchResult T.Text -> Loc.SourceRange
    fullRange :: MatchResult Text -> SourceRange
fullRange MatchResult Text
mr =
        let startLine :: Maybe Int
startLine = MatchResult Text -> Int -> Maybe Int
forall a. Read a => MatchResult Text -> Int -> Maybe a
unpackRead MatchResult Text
mr Int
1
            startCol :: Maybe Int
startCol = MatchResult Text -> Int -> Maybe Int
forall a. Read a => MatchResult Text -> Int -> Maybe a
unpackRead MatchResult Text
mr Int
2
            endLine :: Maybe Int
endLine = MatchResult Text -> Int -> Maybe Int
forall a. Read a => MatchResult Text -> Int -> Maybe a
unpackRead MatchResult Text
mr Int
3
            endCol :: Maybe Int
endCol = MatchResult Text -> Int -> Maybe Int
forall a. Read a => MatchResult Text -> Int -> Maybe a
unpackRead MatchResult Text
mr Int
4
         in Loc.SourceRange{Maybe Int
startLine :: Maybe Int
$sel:startLine:SourceRange :: Maybe Int
startLine, Maybe Int
startCol :: Maybe Int
$sel:startCol:SourceRange :: Maybe Int
startCol, Maybe Int
endLine :: Maybe Int
$sel:endLine:SourceRange :: Maybe Int
endLine, Maybe Int
endCol :: Maybe Int
$sel:endCol:SourceRange :: Maybe Int
endCol}

    lineColRange :: MatchResult T.Text -> Loc.SourceRange
    lineColRange :: MatchResult Text -> SourceRange
lineColRange MatchResult Text
mr =
        let startLine :: Maybe Int
startLine = MatchResult Text -> Int -> Maybe Int
forall a. Read a => MatchResult Text -> Int -> Maybe a
unpackRead MatchResult Text
mr Int
1
            startCol :: Maybe Int
startCol = MatchResult Text -> Int -> Maybe Int
forall a. Read a => MatchResult Text -> Int -> Maybe a
unpackRead MatchResult Text
mr Int
2
            endLine :: Maybe Int
endLine = Maybe Int
startLine
            endCol :: Maybe Int
endCol = MatchResult Text -> Int -> Maybe Int
forall a. Read a => MatchResult Text -> Int -> Maybe a
unpackRead MatchResult Text
mr Int
3
         in Loc.SourceRange{Maybe Int
$sel:startLine:SourceRange :: Maybe Int
startLine :: Maybe Int
startLine, Maybe Int
$sel:startCol:SourceRange :: Maybe Int
startCol :: Maybe Int
startCol, Maybe Int
$sel:endLine:SourceRange :: Maybe Int
endLine :: Maybe Int
endLine, Maybe Int
$sel:endCol:SourceRange :: Maybe Int
endCol :: Maybe Int
endCol}

    lineColSingle :: MatchResult T.Text -> Loc.SourceRange
    lineColSingle :: MatchResult Text -> SourceRange
lineColSingle MatchResult Text
mr =
        let startLine :: Maybe Int
startLine = MatchResult Text -> Int -> Maybe Int
forall a. Read a => MatchResult Text -> Int -> Maybe a
unpackRead MatchResult Text
mr Int
1
            startCol :: Maybe Int
startCol = MatchResult Text -> Int -> Maybe Int
forall a. Read a => MatchResult Text -> Int -> Maybe a
unpackRead MatchResult Text
mr Int
2
            endLine :: Maybe Int
endLine = Maybe Int
startLine
            endCol :: Maybe Int
endCol = (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe Int
startCol
         in Loc.SourceRange{Maybe Int
$sel:startLine:SourceRange :: Maybe Int
startLine :: Maybe Int
startLine, Maybe Int
$sel:startCol:SourceRange :: Maybe Int
startCol :: Maybe Int
startCol, Maybe Int
$sel:endLine:SourceRange :: Maybe Int
endLine :: Maybe Int
endLine, Maybe Int
$sel:endCol:SourceRange :: Maybe Int
endCol :: Maybe Int
endCol}

    onlyLine :: MatchResult T.Text -> Loc.SourceRange
    onlyLine :: MatchResult Text -> SourceRange
onlyLine MatchResult Text
mr =
        let startLine :: Maybe Int
startLine = MatchResult Text -> Int -> Maybe Int
forall a. Read a => MatchResult Text -> Int -> Maybe a
unpackRead MatchResult Text
mr Int
1
            startCol :: Maybe a
startCol = Maybe a
forall a. Maybe a
Nothing
            endLine :: Maybe Int
endLine = Maybe Int
startLine
            endCol :: Maybe a
endCol = Maybe a
forall a. Maybe a
Nothing
         in Loc.SourceRange{Maybe Int
$sel:startLine:SourceRange :: Maybe Int
startLine :: Maybe Int
startLine, Maybe Int
forall a. Maybe a
$sel:startCol:SourceRange :: Maybe Int
startCol :: forall a. Maybe a
startCol, Maybe Int
$sel:endLine:SourceRange :: Maybe Int
endLine :: Maybe Int
endLine, Maybe Int
forall a. Maybe a
$sel:endCol:SourceRange :: Maybe Int
endCol :: forall a. Maybe a
endCol}

{- | Converts a multiline contextText from:

        Stopped in Foo.Bar, other stuff here
        more stuff that doesn't match
        even more stuff

    into ("Foo.Bar", "other stuff here") if the text matches.
-}
eInfoLine :: T.Text -> Either ParseError (T.Text, T.Text)
eInfoLine :: Text -> Either ParseError (Text, Text)
eInfoLine Text
"" = ParseError -> Either ParseError (Text, Text)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (Text, Text))
-> ParseError -> Either ParseError (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> ParseError
ParseError Text
"Could not find info line in empty string"
eInfoLine Text
contextText =
    ParseError -> Maybe (Text, Text) -> Either ParseError (Text, Text)
forall a b. a -> Maybe b -> Either a b
note
        (Text -> ParseError
ParseError [i|Could not match info line: '#{showT splits}'|])
        Maybe (Text, Text)
mStopLine
  where
    splits :: [Text]
splits = Text -> Text -> [Text]
splitBy Text
ghcidPrompt Text
contextText
    mStopLine :: Maybe (Text, Text)
mStopLine = (\MatchResult Text
mr -> (MatchResult Text -> Array Int Text
forall a. MatchResult a -> Array Int a
mrSubs MatchResult Text
mr Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
1, MatchResult Text -> Array Int Text
forall a. MatchResult a -> Array Int a
mrSubs MatchResult Text
mr Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
2)) (MatchResult Text -> (Text, Text))
-> Maybe (MatchResult Text) -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (MatchResult Text)
mStopLineMatchRes
    mStopLineMatchRes :: Maybe (MatchResult Text)
mStopLineMatchRes = (Text -> Maybe (MatchResult Text) -> Maybe (MatchResult Text))
-> Maybe (MatchResult Text) -> [Text] -> Maybe (MatchResult Text)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Text
n Maybe (MatchResult Text)
acc -> Maybe (MatchResult Text)
acc Maybe (MatchResult Text)
-> Maybe (MatchResult Text) -> Maybe (MatchResult Text)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe (MatchResult Text)
stopReg Text
n) Maybe (MatchResult Text)
forall a. Maybe a
Nothing [Text]
splits
    -- Match on the "Stopped in ..." line.
    stopReg :: T.Text -> Maybe (MatchResult T.Text)
    stopReg :: Text -> Maybe (MatchResult Text)
stopReg Text
s = Text
s Text -> Text -> Maybe (MatchResult Text)
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ (Text
"^[ \t]*Stopped in ([[:alnum:]_.()']+),(.*)" :: T.Text)

parseBreakResponse :: T.Text -> Either T.Text [Loc.ModuleLoc]
parseBreakResponse :: Text -> Either Text [ModuleLoc]
parseBreakResponse Text
t
    | Just [MatchResult Text]
xs <- (Text -> Maybe (MatchResult Text))
-> [Text] -> Maybe [MatchResult Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> Maybe (MatchResult Text)
matching (Text -> [Text]
T.lines Text
t) =
        let
            parseEach :: MatchResult T.Text -> Loc.ModuleLoc
            parseEach :: MatchResult Text -> ModuleLoc
parseEach MatchResult Text
mr =
                let moduleName :: Text
moduleName = MatchResult Text
mr.mrSubs Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
2
                    startLine :: Maybe Int
startLine = [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMay ([Char] -> Maybe Int) -> [Char] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ MatchResult Text
mr.mrSubs Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
3
                    endLine :: Maybe Int
endLine = Maybe Int
startLine
                    startCol :: Maybe Int
startCol = [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMay ([Char] -> Maybe Int) -> [Char] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ MatchResult Text
mr.mrSubs Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
4
                    endCol :: Maybe Int
endCol = [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMay ([Char] -> Maybe Int) -> [Char] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ MatchResult Text
mr.mrSubs Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
5
                 in Text -> SourceRange -> ModuleLoc
Loc.ModuleLoc Text
moduleName Loc.SourceRange{Maybe Int
$sel:startLine:SourceRange :: Maybe Int
startLine :: Maybe Int
startLine, Maybe Int
$sel:startCol:SourceRange :: Maybe Int
startCol :: Maybe Int
startCol, Maybe Int
$sel:endLine:SourceRange :: Maybe Int
endLine :: Maybe Int
endLine, Maybe Int
$sel:endCol:SourceRange :: Maybe Int
endCol :: Maybe Int
endCol}
         in
            [ModuleLoc] -> Either Text [ModuleLoc]
forall a b. b -> Either a b
Right ([ModuleLoc] -> Either Text [ModuleLoc])
-> [ModuleLoc] -> Either Text [ModuleLoc]
forall a b. (a -> b) -> a -> b
$ MatchResult Text -> ModuleLoc
parseEach (MatchResult Text -> ModuleLoc)
-> [MatchResult Text] -> [ModuleLoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MatchResult Text]
xs
    | Bool
otherwise = Text -> Either Text [ModuleLoc]
forall a b. a -> Either a b
Left (Text
"Could not parse breakpoint from: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)
  where
    breakpointReg :: Text
breakpointReg =
        Text
"Breakpoint (.*) activated at (.*):([0-9]*):([0-9]*)(-[0-9]*)?" :: T.Text
    matching :: T.Text -> Maybe (MatchResult T.Text)
    matching :: Text -> Maybe (MatchResult Text)
matching = (Text -> Text -> Maybe (MatchResult Text)
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ Text
breakpointReg)

-- | Parse the output from ":show breaks"
parseShowBreaks
    :: T.Text
    -- ^ Message to parse.
    -> Either T.Text [(Int, Loc.ModuleLoc)]
    -- ^ Tuples are (breakpoint index, location).
parseShowBreaks :: Text -> Either Text [(Int, ModuleLoc)]
parseShowBreaks Text
t
    | Just [MatchResult Text]
xs <- ((Text -> Maybe (MatchResult Text))
-> [Text] -> Maybe [MatchResult Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> Maybe (MatchResult Text)
matching ([Text] -> Maybe [MatchResult Text])
-> (Text -> [Text]) -> Text -> Maybe [MatchResult Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines) Text
response = (MatchResult Text -> Either Text (Int, ModuleLoc))
-> [MatchResult Text] -> Either Text [(Int, ModuleLoc)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse MatchResult Text -> Either Text (Int, ModuleLoc)
parseEach [MatchResult Text]
xs
    | Text
response Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"No active breakpoints." = [(Int, ModuleLoc)] -> Either Text [(Int, ModuleLoc)]
forall a b. b -> Either a b
Right [(Int, ModuleLoc)]
forall a. Monoid a => a
mempty
    | Bool
otherwise = Text -> Either Text [(Int, ModuleLoc)]
forall a b. a -> Either a b
Left ([Char] -> Text
T.pack ([Char]
"Response was" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
response))
  where
    response :: Text
response = Text -> Text
T.strip Text
t
    breakpointReg :: Text
breakpointReg =
        Text
"\\[([0-9]+)\\] +(.*) +([^:]*):(.*) +([a-zA-Z_-]+)" :: T.Text

    matching :: T.Text -> Maybe (MatchResult T.Text)
    matching :: Text -> Maybe (MatchResult Text)
matching = (Text -> Text -> Maybe (MatchResult Text)
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ Text
breakpointReg)

    parseEach :: MatchResult T.Text -> Either T.Text (Int, Loc.ModuleLoc)
    parseEach :: MatchResult Text -> Either Text (Int, ModuleLoc)
parseEach MatchResult Text
mr =
        let
            -- Don't need to use readMay because regex.
            eIdx :: Either Text Int
eIdx = Text -> [Char] -> Either Text Int
forall a e. Read a => e -> [Char] -> Either e a
readErr Text
"Failed to read index" ([Char] -> Either Text Int) -> [Char] -> Either Text Int
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ MatchResult Text
mr.mrSubs Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
1
            module_ :: Text
module_ = MatchResult Text
mr.mrSubs Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
2
            _filepath :: Maybe Text
_filepath = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ MatchResult Text
mr.mrSubs Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
3 -- Not used currently but could be useful?
            sourceRange :: SourceRange
sourceRange = Text -> SourceRange
parseSourceRange (Text -> SourceRange) -> Text -> SourceRange
forall a b. (a -> b) -> a -> b
$ MatchResult Text
mr.mrSubs Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
4
            enabled :: Either Text Bool
enabled = case MatchResult Text
mr.mrSubs Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
5 of
                Text
"enabled" -> Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
True
                Text
"disabled" -> Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
False
                Text
x -> Text -> Either Text Bool
forall a b. a -> Either a b
Left (Text
"Breakpoint neither enabled nor disabled: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x)
         in
            case (SourceRange
sourceRange, Either Text Int
eIdx) of
                (SourceRange
_, Right Int
idx)
                    | SourceRange
sourceRange SourceRange -> SourceRange -> Bool
forall a. Eq a => a -> a -> Bool
== SourceRange
Loc.unknownSourceRange ->
                        Text -> Either Text (Int, ModuleLoc)
forall a b. a -> Either a b
Left (Text
"Could not parse source range for breakpoint " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
idx)
                    | Bool
otherwise ->
                        Either Text Bool
enabled Either Text Bool
-> Either Text (Int, ModuleLoc) -> Either Text (Int, ModuleLoc)
forall a b. Either Text a -> Either Text b -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int, ModuleLoc) -> Either Text (Int, ModuleLoc)
forall a b. b -> Either a b
Right (Int
idx, Text -> SourceRange -> ModuleLoc
Loc.ModuleLoc Text
module_ SourceRange
sourceRange)
                (SourceRange
_, Left Text
e) -> Text -> Either Text (Int, ModuleLoc)
forall a b. a -> Either a b
Left Text
e

-- | Parse the output of ":show modules".
parseShowModules :: T.Text -> Either ParseError [(T.Text, FilePath)]
parseShowModules :: Text -> Either ParseError [(Text, [Char])]
parseShowModules Text
t
    | Text -> Bool
T.null Text
stripped = [(Text, [Char])] -> Either ParseError [(Text, [Char])]
forall a b. b -> Either a b
Right []
    | Just [MatchResult Text]
xs <- Maybe [MatchResult Text]
matchingLines =
        let
            parseEach :: MatchResult T.Text -> (T.Text, FilePath)
            parseEach :: MatchResult Text -> (Text, [Char])
parseEach MatchResult Text
mr = (MatchResult Text
mr.mrSubs Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
1, Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ MatchResult Text
mr.mrSubs Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
2)
         in
            [(Text, [Char])] -> Either ParseError [(Text, [Char])]
forall a b. b -> Either a b
Right ([(Text, [Char])] -> Either ParseError [(Text, [Char])])
-> [(Text, [Char])] -> Either ParseError [(Text, [Char])]
forall a b. (a -> b) -> a -> b
$ MatchResult Text -> (Text, [Char])
parseEach (MatchResult Text -> (Text, [Char]))
-> [MatchResult Text] -> [(Text, [Char])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MatchResult Text]
xs
    | Bool
otherwise = ParseError -> Either ParseError [(Text, [Char])]
forall a b. a -> Either a b
Left (Text -> ParseError
ParseError [i|Failed to parse ':show modules': #{stripped}|])
  where
    stripped :: Text
stripped = Text -> Text
T.strip Text
t
    matchingLines :: Maybe [MatchResult Text]
matchingLines = (Text -> Maybe (MatchResult Text)) -> [Text] -> [MatchResult Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe (MatchResult Text)
matching ([Text] -> [MatchResult Text])
-> (Text -> [Text]) -> Text -> [MatchResult Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> [MatchResult Text])
-> Maybe Text -> Maybe [MatchResult Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe Text
forall a. [a] -> Maybe a
lastMay (Text -> Text -> [Text]
splitBy Text
ghcidPrompt Text
stripped)
    reg :: Text
reg = Text
"([[:alnum:]_.']+)[ \\t]+\\( *([^,]*),.*\\)" :: T.Text
    matching :: T.Text -> Maybe (MatchResult T.Text)
    matching :: Text -> Maybe (MatchResult Text)
matching = (Text -> Text -> Maybe (MatchResult Text)
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ Text
reg)

-- Sometimes there's lines that are just Unit '()'. Unsure
-- what they are meant to represent in the binding list.
dropUnitLines :: [T.Text] -> [T.Text]
dropUnitLines :: [Text] -> [Text]
dropUnitLines = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
x -> Text -> Text
T.strip Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"()")

-- | Parse the output of ":show bindings".
parseBindings :: T.Text -> Either T.Text [NameBinding T.Text]
parseBindings :: Text -> Either Text [NameBinding Text]
parseBindings Text
t
    | Text -> Bool
T.null Text
stripped = [NameBinding Text] -> Either Text [NameBinding Text]
forall a b. b -> Either a b
Right []
    | Just [MatchResult Text]
xs <- (Text -> Maybe (MatchResult Text))
-> [Text] -> Maybe [MatchResult Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Text -> Text -> Maybe (MatchResult Text)
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ Text
reg) ([Text] -> [Text]
dropUnitLines ([Text] -> [Text]
mergeBindingLines (Text -> [Text]
T.lines Text
stripped))) =
        let
            parseEach :: MatchResult T.Text -> NameBinding T.Text
            parseEach :: MatchResult Text -> NameBinding Text
parseEach MatchResult Text
mr = Text -> Text -> BindingValue Text -> NameBinding Text
forall t. t -> t -> BindingValue t -> NameBinding t
NameBinding (MatchResult Text
mr.mrSubs Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
1) (MatchResult Text
mr.mrSubs Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
2) (Text -> BindingValue Text
forall a. a -> BindingValue a
Evald (Text -> BindingValue Text) -> Text -> BindingValue Text
forall a b. (a -> b) -> a -> b
$ MatchResult Text
mr.mrSubs Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
3)
         in
            [NameBinding Text] -> Either Text [NameBinding Text]
forall a b. b -> Either a b
Right ([NameBinding Text] -> Either Text [NameBinding Text])
-> [NameBinding Text] -> Either Text [NameBinding Text]
forall a b. (a -> b) -> a -> b
$ MatchResult Text -> NameBinding Text
parseEach (MatchResult Text -> NameBinding Text)
-> [MatchResult Text] -> [NameBinding Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MatchResult Text]
xs
    | Bool
otherwise = Text -> Either Text [NameBinding Text]
forall a b. a -> Either a b
Left (Text
"Failed to parse ':show bindings':\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
stripped)
  where
    stripped :: Text
stripped = Text -> Text
T.strip Text
t

    mergeBindingLines :: [T.Text] -> [T.Text]
    mergeBindingLines :: [Text] -> [Text]
mergeBindingLines [] = []
    mergeBindingLines [Text
x] = [Text
x]
    mergeBindingLines (Text
x1 : Text
x2 : [Text]
xs) =
        case Text -> Maybe (Char, Text)
T.uncons Text
x2 of
            Just (Char
' ', Text
rest) ->
                let newLine :: Text
newLine = (Text -> Text
T.strip Text
x1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.strip Text
rest)
                 in [Text] -> [Text]
mergeBindingLines (Text
newLine Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs)
            Maybe (Char, Text)
_ -> Text
x1 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
mergeBindingLines (Text
x2 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs)

    {- They look like...
        ghci> :show bindings
        somethingLong ::
          [AVeryLong
            SubType
             -> SomeResultType] = value
        _result :: Int = _
        it :: () = ()
    -}
    reg :: Text
reg = Text
"([a-z_][[:alnum:]_.']*) +:: +(.*) += +(.*)" :: T.Text

-- | Whether a given text line represents a failed history lookup.
isHistoryFailureMsg :: T.Text -> Bool
isHistoryFailureMsg :: Text -> Bool
isHistoryFailureMsg Text
text = (Regex
reg Regex -> Text -> Bool
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
`Regex.match` Text
text) Bool -> Bool -> Bool
|| (Regex
reg2 Regex -> Text -> Bool
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
`Regex.match` Text
text)
  where
    execOption :: ExecOption
execOption = Bool -> ExecOption
Regex.ExecOption Bool
False
    compOption :: CompOption
compOption = CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
Regex.defaultCompOpt{Regex.caseSensitive = False}
    makeRegex :: T.Text -> Regex.Regex
    makeRegex :: Text -> Regex
makeRegex = CompOption -> ExecOption -> Text -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
Regex.makeRegexOpts CompOption
compOption ExecOption
execOption
    reg :: Regex
reg = Text -> Regex
makeRegex Text
"not +stopped +at +a +breakpoint"
    reg2 :: Regex
reg2 = Text -> Regex
makeRegex Text
"empty history(\\.)?"

{- | Clean up GHCID exec returned messages/feedback.

Frequently, "exec" may include various GHCID prompts in its
returned messages. Return only the last prompt output, which seems to
include what we want fairly consistently.

Additionally, pack the lines into a single T.Text block.
-}
cleanResponse :: [T.Text] -> T.Text
cleanResponse :: [Text] -> Text
cleanResponse =
    [Text] -> Text
T.unlines
        ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
dropUnitLines
        ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
        (Text -> [Text]) -> ([Text] -> Text) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
forall a. a -> [a] -> a
lastDef Text
""
        ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
splitBy Text
ghcidPrompt
        (Text -> [Text]) -> ([Text] -> Text) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines