{-# 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 (forall a b. (a -> b) -> [a] -> [b]
map String -> String
unescape -> [String]
xs) =
[ (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) forall a b. (a -> b) -> a -> b
$ String -> String
trimStart String
a, forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
',') String
b)
| String
x <- [String]
xs, (String
a,Char
'(':Char
' ':String
b) <- [forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'(') String
x]]
parseShowPaths :: [String] -> (FilePath, [FilePath])
parseShowPaths :: [String] -> (String, [String])
parseShowPaths (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, forall a b. (a -> b) -> [a] -> [b]
map String -> String
trimStart [String]
is)
| Bool
otherwise = (String
".",[])
parseLoad :: [String] -> [Load]
parseLoad :: [String] -> [Load]
parseLoad (forall a b. (a -> b) -> [a] -> [b]
map String -> Esc
Esc -> [Esc]
xs) = forall a. Ord a => [a] -> [a]
nubOrd 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
= forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> Load
Loading) ([String] -> [(String, String)]
parseShowModules [forall a. Int -> [a] -> [a]
drop Int
11 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
']') forall a b. (a -> b) -> a -> b
$ Esc -> String
unescapeE Esc
xs]) forall a. [a] -> [a] -> [a]
++
[Esc] -> [Load]
f [Esc]
rest
f (Esc
x:[Esc]
xs)
| Bool -> Bool
not 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) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
span Esc -> Bool
isMessageBody [Esc]
xs
, Esc
rest <- Esc -> Esc
trimStartE forall a b. (a -> b) -> a -> b
$ [Esc] -> Esc
unwordsE forall a b. (a -> b) -> a -> b
$ Esc
rest forall a. a -> [a] -> [a]
: [Esc]
xs
, Severity
sev <- if String
"warning:" 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 (forall a b. (a -> b) -> [a] -> [b]
map Esc -> String
fromEsc forall a b. (a -> b) -> a -> b
$ Esc
xforall a. a -> [a] -> [a]
:[Esc]
msg) 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] forall a. a -> [a] -> [a]
: [Esc] -> [Load]
f [Esc]
xs
f (Esc
x:[Esc]
xs)
| Esc -> String
unescapeE Esc
x forall a. Eq a => a -> a -> Bool
== String
"<no location info>: error:"
, ([Esc]
xs,[Esc]
rest) <- 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) (forall a b. (a -> b) -> [a] -> [b]
map Esc -> String
fromEsc forall a b. (a -> b) -> a -> b
$ Esc
xforall a. a -> [a] -> [a]
:[Esc]
xs) forall a. a -> [a] -> [a]
: [Esc] -> [Load]
f [Esc]
rest
f (Esc
x:[Esc]
xs)
| Esc -> String
unescapeE Esc
x forall a. Eq a => a -> a -> Bool
== String
"Module imports form a cycle:"
, ([Esc]
xs,[Esc]
rest) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
span Esc -> Bool
leadingWhitespaceE [Esc]
xs
, let ms :: [String]
ms = [forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
')') String
x | Esc
x <- [Esc]
xs, Char
'(':String
x <- [forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'(') 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) (forall a b. (a -> b) -> [a] -> [b]
map Esc -> String
fromEsc forall a b. (a -> b) -> a -> b
$ Esc
xforall a. a -> [a] -> [a]
:[Esc]
xs) | String
m <- forall a. Ord a => [a] -> [a]
nubOrd [String]
ms] 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) 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) <- 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) <- forall {a}. Read a => Esc -> Maybe (a, Esc)
digit Esc
x = case () of
()
_ | Just Esc
x <- String -> Esc -> Maybe Esc
lit String
":" Esc
x -> 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) <- forall {a}. Read a => Esc -> Maybe (a, Esc)
digit Esc
x, Just Esc
x <- String -> Esc -> Maybe Esc
lit String
":" Esc
x -> forall a. a -> Maybe a
Just (((Int
l1,Int
c1),(Int
l1,Int
c2)), Esc
x)
| Bool
otherwise -> forall a. Maybe a
Nothing
| Just ((Int, Int)
p1, Esc
x) <- 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) <- 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 = forall a. a -> Maybe a
Just (((Int, Int)
p1,(Int, Int)
p2),Esc
x)
| Bool
otherwise = 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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) <- 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) <- forall {a}. Read a => Esc -> Maybe (a, Esc)
digit Esc
x
Esc
x <- String -> Esc -> Maybe Esc
lit String
")" Esc
x
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
_) | 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) 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 -> forall a. Maybe a
Nothing
Just (Esc
a,Esc
b)
| [Char
drive] <- Esc -> String
unescapeE Esc
a, Char -> Bool
isLetter Char
drive -> forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (forall a. [a] -> [a] -> [a]
(++) [Char
drive,Char
':'] forall b c a. (b -> c) -> (a -> b) -> a -> c
. Esc -> String
unescapeE) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Esc -> Maybe (Esc, Esc)
stripInfixE String
":" Esc
b
| Bool
otherwise -> forall a. a -> Maybe a
Just (Esc -> String
unescapeE Esc
a, Esc
b)