{-# 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
/= 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]]

-- | 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)
    | (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
".",[])

-- | 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 (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

        -- GHCi.hs:81:1: Warning: Defined but not used: `foo'
        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
             -- take position, including span if present
            , 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

        -- <no location info>: can't find file: FILENAME
        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

        -- <no location info>: error:
        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

        -- Module imports form a cycle:
        --   module `Module' (Module.hs) imports itself
        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

        -- Loaded GHCi configuration from C:\Neil\ghcid\.ghci
        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

-- 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 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)


-- After the file location, message bodies are indented (perhaps prefixed by a line number)
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

-- 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 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)