{-# 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 (..))
import qualified Ghcitui.Loc as Loc
import Ghcitui.NameBinding
import Ghcitui.Util
ghcidPrompt :: T.Text
ghcidPrompt :: Text
ghcidPrompt = Text
"#~GHCID-START~#"
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)
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}'|])
parseSourceRange :: T.Text -> Loc.SourceRange
parseSourceRange :: Text -> SourceRange
parseSourceRange Text
s
| 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
| Just MatchResult Text
mr <- Text -> Maybe (MatchResult Text)
matches Text
"([0-9]+):([0-9]+)-([0-9]+)" = MatchResult Text -> SourceRange
lineColRange MatchResult Text
mr
| Just MatchResult Text
mr <- Text -> Maybe (MatchResult Text)
matches Text
"([0-9]+):([0-9]+)" = MatchResult Text -> SourceRange
lineColSingle MatchResult Text
mr
| 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}
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
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)
parseShowBreaks
:: T.Text
-> Either T.Text [(Int, Loc.ModuleLoc)]
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
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
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
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)
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
"()")
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)
reg :: Text
reg = Text
"([a-z_][[:alnum:]_.']*) +:: +(.*) += +(.*)" :: T.Text
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(\\.)?"
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