{-# 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 (map unescape -> xs) =
[ (takeWhile (not . isSpace) $ trimStart a, takeWhile (/= ',') b)
| x <- xs, (a,'(':' ':b) <- [break (== '(') x]]
parseShowPaths :: [String] -> (FilePath, [FilePath])
parseShowPaths (map unescape -> xs)
| (_:x:_:is) <- xs = (trimStart x, map trimStart is)
| otherwise = (".",[])
parseLoad :: [String] -> [Load]
parseLoad (map Esc -> xs) = nubOrd $ f xs
where
f :: [Esc] -> [Load]
f (xs:rest)
| Just xs <- stripPrefixE "[" xs
= map (uncurry Loading) (parseShowModules [drop 11 $ dropWhile (/= ']') $ unescapeE xs]) ++
f rest
f (x:xs)
| not $ " " `isPrefixOfE` x
, Just (file,rest) <- breakFileColon x
, Just ((pos1, pos2), rest) <- parsePosition rest
, (msg,las) <- span isMessageBody xs
, rest <- trimStartE $ unwordsE $ rest : xs
, sev <- if "warning:" `isPrefixOf` lower (unescapeE rest) then Warning else Error
= Message sev file pos1 pos2 (map fromEsc $ x:msg) : f las
f (x:xs)
| Just file <- stripPrefixE "<no location info>: can't find file: " x
= Message Error (unescapeE file) (0,0) (0,0) [fromEsc x] : f xs
f (x:xs)
| unescapeE x == "Module imports form a cycle:"
, (xs,rest) <- span (isPrefixOfE " ") xs
, let ms = [takeWhile (/= ')') x | x <- xs, '(':x <- [dropWhile (/= '(') $ unescapeE x]]
= [Message Error m (0,0) (0,0) (map fromEsc $ x:xs) | m <- nubOrd ms] ++ f rest
f (x:xs)
| Just x <- stripPrefixE "Loaded GHCi configuration from " x
= LoadConfig (unescapeE x) : f xs
f (_:xs) = f xs
f [] = []
parsePosition :: Esc -> Maybe (((Int, Int), (Int, Int)), Esc)
parsePosition x
| Just (l1, x) <- digit x, Just x <- lit ":" x, Just (c1, x) <- digit x = case () of
_ | Just x <- lit ":" x -> Just (((l1,c1),(l1,c1)), x)
| Just x <- lit "-" x, Just (c2,x) <- digit x, Just x <- lit ":" x -> Just (((l1,c1),(l1,c2)), x)
| otherwise -> Nothing
| Just (p1, x) <- digits x, Just x <- lit "-" x, Just (p2, x) <- digits x, Just x <- lit ":" x = Just ((p1,p2),x)
| otherwise = Nothing
where
lit = stripPrefixE
digit x = (,b) <$> readMaybe (unescapeE a)
where (a,b) = spanE isDigit x
digits x = do
x <- lit "(" x
(l,x) <- digit x
x <- lit "," x
(c,x) <- digit x
x <- lit ")" x
return ((l,c),x)
isMessageBody :: Esc -> Bool
isMessageBody xs = isPrefixOfE " " xs || case stripInfixE "|" xs of
Just (prefix, _) | all (\x -> isSpace x || isDigit x) $ unescapeE prefix -> True
_ -> False
breakFileColon :: Esc -> Maybe (FilePath, Esc)
breakFileColon xs = case stripInfixE ":" xs of
Nothing -> Nothing
Just (a,b)
| [drive] <- unescapeE a, isLetter drive -> first ((++) [drive,':'] . unescapeE) <$> stripInfixE ":" b
| otherwise -> Just (unescapeE a, b)