{-# LANGUAGE PatternGuards, ViewPatterns, TupleSections #-}
module Language.Haskell.Ghcid.Parser(
parseShowModules, parseShowPaths, parseLoad
) where
import System.FilePath
import Data.Char
import Data.List.Extra
import Data.Maybe
import Text.Read
import Data.Tuple.Extra
import Control.Applicative
import Prelude
import Language.Haskell.Ghcid.Types
import Language.Haskell.Ghcid.Escape
parseShowModules :: [String] -> [(String, FilePath)]
parseShowModules :: [String] -> [(String, String)]
parseShowModules ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
unescape -> [String]
xs) =
[ ((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 -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
trimStart String
a, (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',') String
b)
| String
x <- [String]
xs, (String
a,Char
'(':Char
' ':String
b) <- [(Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(') String
x]]
parseShowPaths :: [String] -> (FilePath, [FilePath])
parseShowPaths :: [String] -> (String, [String])
parseShowPaths ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
unescape -> [String]
xs)
| (String
_:String
x:String
_:[String]
is) <- [String]
xs = (String -> String
trimStart String
x, (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
trimStart [String]
is)
| Bool
otherwise = (String
".",[])
parseLoad :: [String] -> [Load]
parseLoad :: [String] -> [Load]
parseLoad ((String -> Esc) -> [String] -> [Esc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Esc
Esc -> [Esc]
xs) = [Load] -> [Load]
forall a. Ord a => [a] -> [a]
nubOrd ([Load] -> [Load]) -> [Load] -> [Load]
forall a b. (a -> b) -> a -> b
$ [Esc] -> [Load]
f [Esc]
xs
where
f :: [Esc] -> [Load]
f :: [Esc] -> [Load]
f (Esc
xs:[Esc]
rest)
| Just Esc
xs <- String -> Esc -> Maybe Esc
stripPrefixE String
"[" Esc
xs
= ((String, String) -> Load) -> [(String, String)] -> [Load]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> Load) -> (String, String) -> Load
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> Load
Loading) ([String] -> [(String, String)]
parseShowModules [Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
11 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Esc -> String
unescapeE Esc
xs]) [Load] -> [Load] -> [Load]
forall a. [a] -> [a] -> [a]
++
[Esc] -> [Load]
f [Esc]
rest
f (Esc
x:[Esc]
xs)
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String
" " String -> Esc -> Bool
`isPrefixOfE` Esc
x
, Just (String
file,Esc
rest) <- Esc -> Maybe (String, Esc)
breakFileColon Esc
x
, Just (((Int, Int)
pos1, (Int, Int)
pos2), Esc
rest) <- Esc -> Maybe (((Int, Int), (Int, Int)), Esc)
parsePosition Esc
rest
, ([Esc]
msg,[Esc]
las) <- (Esc -> Bool) -> [Esc] -> ([Esc], [Esc])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Esc -> Bool
isMessageBody [Esc]
xs
, Esc
rest <- Esc -> Esc
trimStartE (Esc -> Esc) -> Esc -> Esc
forall a b. (a -> b) -> a -> b
$ [Esc] -> Esc
unwordsE ([Esc] -> Esc) -> [Esc] -> Esc
forall a b. (a -> b) -> a -> b
$ Esc
rest Esc -> [Esc] -> [Esc]
forall a. a -> [a] -> [a]
: [Esc]
xs
, Severity
sev <- if String
"warning:" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String -> String
lower (Esc -> String
unescapeE Esc
rest) then Severity
Warning else Severity
Error
= Severity -> String -> (Int, Int) -> (Int, Int) -> [String] -> Load
Message Severity
sev String
file (Int, Int)
pos1 (Int, Int)
pos2 ((Esc -> String) -> [Esc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Esc -> String
fromEsc ([Esc] -> [String]) -> [Esc] -> [String]
forall a b. (a -> b) -> a -> b
$ Esc
xEsc -> [Esc] -> [Esc]
forall a. a -> [a] -> [a]
:[Esc]
msg) Load -> [Load] -> [Load]
forall a. a -> [a] -> [a]
: [Esc] -> [Load]
f [Esc]
las
f (Esc
x:[Esc]
xs)
| Just Esc
file <- String -> Esc -> Maybe Esc
stripPrefixE String
"<no location info>: can't find file: " Esc
x
= Severity -> String -> (Int, Int) -> (Int, Int) -> [String] -> Load
Message Severity
Error (Esc -> String
unescapeE Esc
file) (Int
0,Int
0) (Int
0,Int
0) [Esc -> String
fromEsc Esc
x] Load -> [Load] -> [Load]
forall a. a -> [a] -> [a]
: [Esc] -> [Load]
f [Esc]
xs
f (Esc
x:[Esc]
xs)
| String
"<no location info>: error:" String -> Esc -> Bool
`isPrefixOfE` Esc
x
, ([Esc]
xs,[Esc]
rest) <- (Esc -> Bool) -> [Esc] -> ([Esc], [Esc])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Esc -> Bool
leadingWhitespaceE [Esc]
xs
= Severity -> String -> (Int, Int) -> (Int, Int) -> [String] -> Load
Message Severity
Error String
"<unknown>" (Int
0,Int
0) (Int
0,Int
0) ((Esc -> String) -> [Esc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Esc -> String
fromEsc ([Esc] -> [String]) -> [Esc] -> [String]
forall a b. (a -> b) -> a -> b
$ Esc
xEsc -> [Esc] -> [Esc]
forall a. a -> [a] -> [a]
:[Esc]
xs) Load -> [Load] -> [Load]
forall a. a -> [a] -> [a]
: [Esc] -> [Load]
f [Esc]
rest
f (Esc
x:[Esc]
xs)
| Esc -> String
unescapeE Esc
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Module imports form a cycle:"
, ([Esc]
xs,[Esc]
rest) <- (Esc -> Bool) -> [Esc] -> ([Esc], [Esc])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Esc -> Bool
leadingWhitespaceE [Esc]
xs
, let ms :: [String]
ms = [(Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
')') String
x | Esc
x <- [Esc]
xs, Char
'(':String
x <- [(Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'(') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Esc -> String
unescapeE Esc
x]]
= [Severity -> String -> (Int, Int) -> (Int, Int) -> [String] -> Load
Message Severity
Error String
m (Int
0,Int
0) (Int
0,Int
0) ((Esc -> String) -> [Esc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Esc -> String
fromEsc ([Esc] -> [String]) -> [Esc] -> [String]
forall a b. (a -> b) -> a -> b
$ Esc
xEsc -> [Esc] -> [Esc]
forall a. a -> [a] -> [a]
:[Esc]
xs) | String
m <- [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd [String]
ms] [Load] -> [Load] -> [Load]
forall a. [a] -> [a] -> [a]
++ [Esc] -> [Load]
f [Esc]
rest
f (Esc
x:[Esc]
xs)
| Just Esc
x <- String -> Esc -> Maybe Esc
stripPrefixE String
"Loaded GHCi configuration from " Esc
x
= String -> Load
LoadConfig (Esc -> String
unescapeE Esc
x) Load -> [Load] -> [Load]
forall a. a -> [a] -> [a]
: [Esc] -> [Load]
f [Esc]
xs
f (Esc
_:[Esc]
xs) = [Esc] -> [Load]
f [Esc]
xs
f [] = []
leadingWhitespaceE :: Esc -> Bool
leadingWhitespaceE :: Esc -> Bool
leadingWhitespaceE Esc
x =
String -> Esc -> Bool
isPrefixOfE String
" " Esc
x Bool -> Bool -> Bool
|| String -> Esc -> Bool
isPrefixOfE String
"\t" Esc
x
parsePosition :: Esc -> Maybe (((Int, Int), (Int, Int)), Esc)
parsePosition :: Esc -> Maybe (((Int, Int), (Int, Int)), Esc)
parsePosition Esc
x
| Just (Int
l1, Esc
x) <- Esc -> Maybe (Int, Esc)
forall {a}. Read a => Esc -> Maybe (a, Esc)
digit Esc
x, Just Esc
x <- String -> Esc -> Maybe Esc
lit String
":" Esc
x, Just (Int
c1, Esc
x) <- Esc -> Maybe (Int, Esc)
forall {a}. Read a => Esc -> Maybe (a, Esc)
digit Esc
x = case () of
()
_ | Just Esc
x <- String -> Esc -> Maybe Esc
lit String
":" Esc
x -> (((Int, Int), (Int, Int)), Esc)
-> Maybe (((Int, Int), (Int, Int)), Esc)
forall a. a -> Maybe a
Just (((Int
l1,Int
c1),(Int
l1,Int
c1)), Esc
x)
| Just Esc
x <- String -> Esc -> Maybe Esc
lit String
"-" Esc
x, Just (Int
c2,Esc
x) <- Esc -> Maybe (Int, Esc)
forall {a}. Read a => Esc -> Maybe (a, Esc)
digit Esc
x, Just Esc
x <- String -> Esc -> Maybe Esc
lit String
":" Esc
x -> (((Int, Int), (Int, Int)), Esc)
-> Maybe (((Int, Int), (Int, Int)), Esc)
forall a. a -> Maybe a
Just (((Int
l1,Int
c1),(Int
l1,Int
c2)), Esc
x)
| Bool
otherwise -> Maybe (((Int, Int), (Int, Int)), Esc)
forall a. Maybe a
Nothing
| Just ((Int, Int)
p1, Esc
x) <- Esc -> Maybe ((Int, Int), Esc)
forall {a} {b}. (Read a, Read b) => Esc -> Maybe ((a, b), Esc)
digits Esc
x, Just Esc
x <- String -> Esc -> Maybe Esc
lit String
"-" Esc
x, Just ((Int, Int)
p2, Esc
x) <- Esc -> Maybe ((Int, Int), Esc)
forall {a} {b}. (Read a, Read b) => Esc -> Maybe ((a, b), Esc)
digits Esc
x, Just Esc
x <- String -> Esc -> Maybe Esc
lit String
":" Esc
x = (((Int, Int), (Int, Int)), Esc)
-> Maybe (((Int, Int), (Int, Int)), Esc)
forall a. a -> Maybe a
Just (((Int, Int)
p1,(Int, Int)
p2),Esc
x)
| Bool
otherwise = Maybe (((Int, Int), (Int, Int)), Esc)
forall a. Maybe a
Nothing
where
lit :: String -> Esc -> Maybe Esc
lit = String -> Esc -> Maybe Esc
stripPrefixE
digit :: Esc -> Maybe (a, Esc)
digit Esc
x = (,Esc
b) (a -> (a, Esc)) -> Maybe a -> Maybe (a, Esc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (Esc -> String
unescapeE Esc
a)
where (Esc
a,Esc
b) = (Char -> Bool) -> Esc -> (Esc, Esc)
spanE Char -> Bool
isDigit Esc
x
digits :: Esc -> Maybe ((a, b), Esc)
digits Esc
x = do
Esc
x <- String -> Esc -> Maybe Esc
lit String
"(" Esc
x
(a
l,Esc
x) <- Esc -> Maybe (a, Esc)
forall {a}. Read a => Esc -> Maybe (a, Esc)
digit Esc
x
Esc
x <- String -> Esc -> Maybe Esc
lit String
"," Esc
x
(b
c,Esc
x) <- Esc -> Maybe (b, Esc)
forall {a}. Read a => Esc -> Maybe (a, Esc)
digit Esc
x
Esc
x <- String -> Esc -> Maybe Esc
lit String
")" Esc
x
((a, b), Esc) -> Maybe ((a, b), Esc)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a
l,b
c),Esc
x)
isMessageBody :: Esc -> Bool
isMessageBody :: Esc -> Bool
isMessageBody Esc
xs = String -> Esc -> Bool
isPrefixOfE String
" " Esc
xs Bool -> Bool -> Bool
|| case String -> Esc -> Maybe (Esc, Esc)
stripInfixE String
"|" Esc
xs of
Just (Esc
prefix, Esc
_) | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Char
x -> Char -> Bool
isSpace Char
x Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
x) (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Esc -> String
unescapeE Esc
prefix -> Bool
True
Maybe (Esc, Esc)
_ -> Bool
False
breakFileColon :: Esc -> Maybe (FilePath, Esc)
breakFileColon :: Esc -> Maybe (String, Esc)
breakFileColon Esc
xs = case String -> Esc -> Maybe (Esc, Esc)
stripInfixE String
":" Esc
xs of
Maybe (Esc, Esc)
Nothing -> Maybe (String, Esc)
forall a. Maybe a
Nothing
Just (Esc
a,Esc
b)
| [Char
drive] <- Esc -> String
unescapeE Esc
a, Char -> Bool
isLetter Char
drive -> (Esc -> String) -> (Esc, Esc) -> (String, Esc)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (String -> String -> String
forall a. [a] -> [a] -> [a]
(++) [Char
drive,Char
':'] (String -> String) -> (Esc -> String) -> Esc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Esc -> String
unescapeE) ((Esc, Esc) -> (String, Esc))
-> Maybe (Esc, Esc) -> Maybe (String, Esc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Esc -> Maybe (Esc, Esc)
stripInfixE String
":" Esc
b
| Bool
otherwise -> (String, Esc) -> Maybe (String, Esc)
forall a. a -> Maybe a
Just (Esc -> String
unescapeE Esc
a, Esc
b)