{-# LANGUAGE PatternGuards, ViewPatterns, TupleSections #-}

-- | Parses the output from GHCi
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


-- | Parse messages from show modules command. Given the parsed lines
--   return a list of (module name, file).
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) =
    -- we only return raw values, don't want any escape codes in there
    [ ((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
/= ',') String
b)
    | String
x <- [String]
xs, (a :: String
a,'(':' ':b :: 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
== '(') String
x]]

-- | Parse messages from show paths command. Given the parsed lines
--   return (current working directory, module import search paths)
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)
    | (_:x :: String
x:_:is :: [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 = (".",[])

-- | Parse messages given on reload.
parseLoad :: [String] -> [Load]
-- nub, because cabal repl sometimes does two reloads at the start
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]

        -- [1 of 2] Compiling GHCi             ( GHCi.hs, interpreted )
        f :: [Esc] -> [Load]
f (xs :: Esc
xs:rest :: [Esc]
rest)
            | Just xs :: Esc
xs <- String -> Esc -> Maybe Esc
stripPrefixE "[" 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 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
/= ']') (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

        -- GHCi.hs:81:1: Warning: Defined but not used: `foo'
        f (x :: Esc
x:xs :: [Esc]
xs)
            | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ " " String -> Esc -> Bool
`isPrefixOfE` Esc
x
            , Just (file :: String
file,rest :: Esc
rest) <- Esc -> Maybe (String, Esc)
breakFileColon Esc
x
             -- take position, including span if present
            , Just ((pos1 :: (Int, Int)
pos1, pos2 :: (Int, Int)
pos2), rest :: Esc
rest) <- Esc -> Maybe (((Int, Int), (Int, Int)), Esc)
parsePosition Esc
rest
            , (msg :: [Esc]
msg,las :: [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 "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

        -- <no location info>: can't find file: FILENAME
        f (x :: Esc
x:xs :: [Esc]
xs)
            | Just file :: Esc
file <- String -> Esc -> Maybe Esc
stripPrefixE "<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) (0,0) (0,0) [Esc -> String
fromEsc Esc
x] Load -> [Load] -> [Load]
forall a. a -> [a] -> [a]
: [Esc] -> [Load]
f [Esc]
xs

        -- <no location info>: error:
        f (x :: Esc
x:xs :: [Esc]
xs)
            | Esc -> String
unescapeE Esc
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "<no location info>: error:"
            , (xs :: [Esc]
xs,rest :: [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 "<unknown>" (0,0) (0,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

        -- Module imports form a cycle:
        --   module `Module' (Module.hs) imports itself
        f (x :: Esc
x:xs :: [Esc]
xs)
            | Esc -> String
unescapeE Esc
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "Module imports form a cycle:"
            , (xs :: [Esc]
xs,rest :: [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
/= ')') String
x | Esc
x <- [Esc]
xs, '(':x :: String
x <- [(Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '(') (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 (0,0) (0,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

        -- Loaded GHCi configuration from C:\Neil\ghcid\.ghci
        f (x :: Esc
x:xs :: [Esc]
xs)
            | Just x :: Esc
x <- String -> Esc -> Maybe Esc
stripPrefixE "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 (_:xs :: [Esc]
xs) = [Esc] -> [Load]
f [Esc]
xs
        f [] = []

leadingWhitespaceE :: Esc -> Bool
leadingWhitespaceE :: Esc -> Bool
leadingWhitespaceE x :: Esc
x =
    String -> Esc -> Bool
isPrefixOfE " " Esc
x Bool -> Bool -> Bool
|| String -> Esc -> Bool
isPrefixOfE "\t" Esc
x

-- 1:2:
-- 1:2-4:
-- (1,2)-(3,4):
parsePosition :: Esc -> Maybe (((Int, Int), (Int, Int)), Esc)
parsePosition :: Esc -> Maybe (((Int, Int), (Int, Int)), Esc)
parsePosition x :: Esc
x
    | Just (l1 :: Int
l1, x :: Esc
x) <- Esc -> Maybe (Int, Esc)
forall t. Read t => Esc -> Maybe (t, Esc)
digit Esc
x, Just x :: Esc
x <- String -> Esc -> Maybe Esc
lit ":" Esc
x, Just (c1 :: Int
c1, x :: Esc
x) <- Esc -> Maybe (Int, Esc)
forall t. Read t => Esc -> Maybe (t, Esc)
digit Esc
x = case () of
        _ | Just x :: Esc
x <- String -> Esc -> Maybe Esc
lit ":" 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 x :: Esc
x <- String -> Esc -> Maybe Esc
lit "-" Esc
x, Just (c2 :: Int
c2,x :: Esc
x) <- Esc -> Maybe (Int, Esc)
forall t. Read t => Esc -> Maybe (t, Esc)
digit Esc
x, Just x :: Esc
x <- String -> Esc -> Maybe Esc
lit ":" 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 (p1 :: (Int, Int)
p1, x :: Esc
x) <- Esc -> Maybe ((Int, Int), Esc)
forall a b. (Read a, Read b) => Esc -> Maybe ((a, b), Esc)
digits Esc
x, Just x :: Esc
x <- String -> Esc -> Maybe Esc
lit "-" Esc
x, Just (p2 :: (Int, Int)
p2, x :: Esc
x) <- Esc -> Maybe ((Int, Int), Esc)
forall a b. (Read a, Read b) => Esc -> Maybe ((a, b), Esc)
digits Esc
x, Just x :: Esc
x <- String -> Esc -> Maybe Esc
lit ":" 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 (t, Esc)
digit x :: Esc
x = (,Esc
b) (t -> (t, Esc)) -> Maybe t -> Maybe (t, Esc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe t
forall a. Read a => String -> Maybe a
readMaybe (Esc -> String
unescapeE Esc
a)
            where (a :: Esc
a,b :: Esc
b) = (Char -> Bool) -> Esc -> (Esc, Esc)
spanE Char -> Bool
isDigit Esc
x

        digits :: Esc -> Maybe ((a, b), Esc)
digits x :: Esc
x =  do
            Esc
x <- String -> Esc -> Maybe Esc
lit "(" Esc
x
            (l :: a
l,x :: Esc
x) <- Esc -> Maybe (a, Esc)
forall t. Read t => Esc -> Maybe (t, Esc)
digit Esc
x
            Esc
x <- String -> Esc -> Maybe Esc
lit "," Esc
x
            (c :: b
c,x :: Esc
x) <- Esc -> Maybe (b, Esc)
forall t. Read t => Esc -> Maybe (t, Esc)
digit Esc
x
            Esc
x <- String -> Esc -> Maybe Esc
lit ")" Esc
x
            ((a, b), Esc) -> Maybe ((a, b), Esc)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a
l,b
c),Esc
x)


-- After the file location, message bodies are indented (perhaps prefixed by a line number)
isMessageBody :: Esc -> Bool
isMessageBody :: Esc -> Bool
isMessageBody xs :: Esc
xs = String -> Esc -> Bool
isPrefixOfE " " Esc
xs Bool -> Bool -> Bool
|| case String -> Esc -> Maybe (Esc, Esc)
stripInfixE "|" Esc
xs of
  Just (prefix :: Esc
prefix, _) | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\x :: 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
  _ -> Bool
False

-- A filename, followed by a colon - be careful to handle Windows drive letters, see #61
breakFileColon :: Esc -> Maybe (FilePath, Esc)
breakFileColon :: Esc -> Maybe (String, Esc)
breakFileColon xs :: Esc
xs = case String -> Esc -> Maybe (Esc, Esc)
stripInfixE ":" Esc
xs of
    Nothing -> Maybe (String, Esc)
forall a. Maybe a
Nothing
    Just (a :: Esc
a,b :: Esc
b)
        | [drive :: 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,':'] (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 ":" Esc
b
        | Bool
otherwise -> (String, Esc) -> Maybe (String, Esc)
forall a. a -> Maybe a
Just (Esc -> String
unescapeE Esc
a, Esc
b)